home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 1 #1 / utv1n1s1.d64 / calendar creator (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1988-01-01  |  8.9 KB  |  398 lines
  1. 1 rem (c)1987 uptime magazine
  2. 2 rem (c)1987 softdisk publishing, inc.
  3. 3 :
  4. 4 rem authors: john bayes
  5. 5 rem          dave hammond
  6. 6 :
  7. 9 uptime=(8*4096)+4
  8. 10 dim mnth$(12),maxday(12),days(31)
  9. 15 for a=1to12: read mnth$(a), maxday(a): next: print"[147]"
  10. 16 :
  11. 20 gosub 2000: rem *** set up screen ***
  12. 21 :
  13. 22 get k$: if (k$<>" ") and (k$<>chr$(140)) then 22
  14. 23 if k$=chr$(140) then poke 186,8: sys uptime
  15. 24 :
  16. 25 mn=0: mnth$="": gosub 2200: rem *** prompt #1 ***
  17. 26 :
  18. 30 get k$: if (k$<>"1") and (k$<>"2") then 30
  19. 35 on val(k$) gosub 2300, 2500: rem *** 1=month, 2=year ***
  20. 36 :
  21. 40 date$=mnth$+", "+t$
  22. 42 if mn=0 then date$="[212]he year "+t$
  23. 46 gosub 1800: rem *** pad the date ***
  24. 48 :
  25. 50 gosub 2600: rem *** prompt #2 ***
  26. 60 get k$: if (k$<"1") or (k$>"3") then 60
  27. 70 on val(k$) goto 100, 400, 700: rem *** 1-screen, 2-printer, 3-restart ***
  28. 95 :
  29. 96 rem ******************
  30. 97 rem  output to screen
  31. 98 rem ******************
  32. 99 :
  33. 100 year$=right$(str$(yr),4): py=yr
  34. 108 bm=1: lm=12: if mn<>0 then bm=mn: lm=mn
  35. 109 :
  36. 110 for y=bmtolm
  37. 115 mn=y: yr=py
  38. 120 gosub 1700: rem *** display calendar template ***
  39. 130 gosub 6000: rem *** calc the calendar ***
  40. 140 gosub 1600: rem *** display days of month ***
  41. 145 :
  42. 150 print"";
  43. 165 p$="[195]alendar for "+mnth$(y)+", "+year$
  44. 170 z=int((40-len(p$))/2)
  45. 175 printspc(z)"[146][159]"p$
  46. 195 printspc(6)"[146][159][208]ress [211]pace [194]ar[159] to continue"
  47. 200 get k$: if k$<>" " then 200
  48. 210 gosub 1940: next
  49. 230 goto 20: rem *** restart ***
  50. 395 :
  51. 396 rem *******************
  52. 397 rem  output to printer
  53. 398 rem *******************
  54. 399 :
  55. 400 gosub 2700: rem *** prompt for lptr ***
  56. 405 :
  57. 410 get k$: if (k$<>"1") and (k$<>"2") then 410
  58. 420 if k$="2" then goto 50
  59. 430 close 4: open4,4,7: if (st and 128) then close4: gosub 2800: goto 400
  60. 435 :
  61. 440 gosub 1400: rem *** def lptr strings ***
  62. 445 :
  63. 450 year$=right$(str$(yr),4): py=yr
  64. 460 bm=1: lm=12: if mn<>0 then bm=mn: lm=mn
  65. 465 :
  66. 466 rem ************
  67. 467 rem  print loop
  68. 468 rem ************
  69. 469 :
  70. 470 mn=bm: yr=py
  71. 475 :
  72. 480 gosub 1700: rem *** display calendar template ***
  73. 490 gosub 6000: rem *** calc the calendar ***
  74. 500 gosub 1600: rem *** screen output ***
  75. 501 :
  76. 502 print"";
  77. 504 p$="[195]alendar for "+mnth$(bm)+", "+year$
  78. 506 z=int((40-len(p$))/2)
  79. 508 printspc(z)"[146][159]"p$
  80. 509 :
  81. 510 gosub 2900: rem *** lptr output ***
  82. 515 :
  83. 560 printspc(6)"[146][159][208]ress [211]pace [194]ar[159] to continue"
  84. 570 get k$: if k$<>" " then 570
  85. 580 gosub 1940: bm=bm+1: if bm<=lm then 470: rem *** continue
  86. 590 print#4: close4: goto 20: rem *** restart ***
  87. 695 :
  88. 696 rem *****************
  89. 697 rem  incorrect entry
  90. 698 rem *****************
  91. 699 :
  92. 700 gosub 1900
  93. 710 print"";
  94. 720 gosub 2120
  95. 730 goto 22
  96. 995 :
  97. 996 rem ***************
  98. 997 rem  calendar data
  99. 998 rem ***************
  100. 999 :
  101. 1000 data "[202]anuary",31,"[198]ebruary",29,"[205]arch",31
  102. 1010 data "[193]pril",30,"[205]ay",31,"[202]une",30,"[202]uly",31
  103. 1020 data "[193]ugust",31,"[211]eptember",30,"[207]ctober",31
  104. 1030 data "[206]ovember",30,"[196]ecember",31
  105. 1395 :
  106. 1396 rem ************************
  107. 1397 rem  define printer strings
  108. 1398 rem ************************
  109. 1399 :
  110. 1400 p1$="[176][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][178]"
  111. 1402 p2$="[192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][174]"
  112. 1404 p3$="[171][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][219]"
  113. 1406 p4$="[192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][179]"
  114. 1408 p5$="[173][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][177]"
  115. 1410 p6$="[192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][189]"
  116. 1412 p7$="[221]         [221]         [221]         [221]"
  117. 1414 p8$="         [221]         [221]         [221]         [221]"
  118. 1420 p3$="[171][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][219]"
  119. 1430 p4$="[192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][179]"
  120. 1440 return
  121. 1595 :
  122. 1596 rem **********************
  123. 1597 rem  print days to screen
  124. 1598 rem **********************
  125. 1599 :
  126. 1600 f=0: print"";
  127. 1605 for x=1toeom
  128. 1610 if (day(1)=0) then goto 1650
  129. 1611 :
  130. 1615 if f=1 then 1650
  131. 1620 f=1: b=day(1)
  132. 1630 for x1=1tob: print"  ";
  133. 1640 next
  134. 1645 :
  135. 1650 x$=str$(x): if len(x$)>2 then x$=right$(x$,2)
  136. 1660 print"";x$;"";
  137. 1670 if peek(211)=38 then print:print"";
  138. 1675 if peek(214)=18 then print"[145][145]";
  139. 1680 next
  140. 1690 return
  141. 1695 :
  142. 1696 rem ******************
  143. 1697 rem  display calendar
  144. 1698 rem ******************
  145. 1699 :
  146. 1700 print"";tl$
  147. 1710 print"  [221][211]un.[221][205]on.[221][212]ue.[221][215]ed.[221][212]hr.[221][198]ri.[221][211]at.[221]"
  148. 1720 print"  ";m2$
  149. 1730 for x=1to14
  150. 1740 p$=m1$: if (x/3)=int(x/3) then p$=m2$
  151. 1750 print"  ";p$
  152. 1760 next
  153. 1770 print"  "bl$
  154. 1780 return
  155. 1795 :
  156. 1796 rem **************
  157. 1797 rem  pad the date
  158. 1798 rem **************
  159. 1799 :
  160. 1800 pad=int((18-len(date$))/2)
  161. 1810 for x=1topad
  162. 1820 date$=" "+date$
  163. 1830 next
  164. 1840 date$=left$(date$+"        ",18)
  165. 1850 return
  166. 1895 :
  167. 1896 rem *****************
  168. 1897 rem  clear text area
  169. 1898 rem *****************
  170. 1899 :
  171. 1900 print"";
  172. 1910 printspc(11)"[158]                  "
  173. 1920 print"";
  174. 1930 for x=1to4: printspc(11)"[158]                  ": next
  175. 1940 print"";
  176. 1950 for x=1to6: print"                                       ";
  177. 1953 if x<6 then print
  178. 1955 next
  179. 1960 print"";
  180. 1970 return
  181. 1995 :
  182. 1996 rem ***************
  183. 1997 rem  set up screen
  184. 1998 rem ***************
  185. 1999 :
  186. 2000 poke 53280,0: poke 53281,0
  187. 2010 printchr$(8)chr$(14)
  188. 2020 tl$="[176][192][192][192][192][178][192][192][192][192][178][192][192][192][192][178][192][192][192][192][178][192][192][192][192][178][192][192][192][192][178][192][192][192][192][174]"
  189. 2030 bl$="[173][192][192][192][192][177][192][192][192][192][177][192][192][192][192][177][192][192][192][192][177][192][192][192][192][177][192][192][192][192][177][192][192][192][192][189]"
  190. 2040 m1$="[221]    [221]    [221]    [221]    [221]    [221]    [221]    [221]"
  191. 2050 m2$="[171][192][192][192][192][219][192][192][192][192][219][192][192][192][192][219][192][192][192][192][219][192][192][192][192][219][192][192][192][192][219][192][192][192][192][179]"
  192. 2060 gosub 1700: rem *** display calendar ***
  193. 2120 printspc(4)"[159][208]ress the [211]pace [194]ar[159] to continue"
  194. 2125 printspc(7)"[159][208]ress [198]8[159] to exit to [213]p[212]ime"
  195. 2130 printspc(3)"[158](c)1987 [211]oftdisk [208]ublishing, [201]nc."
  196. 2140 printspc(9)"[151]                    "
  197. 2142 printspc(9)"[151] [158][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  198. 2144 printspc(9)"[151] [158][221] [195]alendar [195]reator [221]"
  199. 2146 printspc(9)"[151] [158][171][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][179]"
  200. 2148 printspc(9)"[151] [158][221] by               [221]"
  201. 2150 printspc(9)"[151] [158][221]    [202]ohn [194]ayes    [221]"
  202. 2152 printspc(9)"[151] [158][221]       and        [221]"
  203. 2154 printspc(9)"[151] [158][221]   [196]ave [200]ammond   [221]"
  204. 2156 printspc(10)"[158][173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  205. 2190 return
  206. 2195 :
  207. 2196 rem ***********
  208. 2197 rem  prompt #1
  209. 2198 rem ***********
  210. 2199 :
  211. 2200 gosub 1900: rem *** clear text area ***
  212. 2205 :
  213. 2210 printspc(11)"[158] [212]ype of [195]alendar"
  214. 2220 printspc(11)"[158]     1[158]- [205]onth"
  215. 2230 printspc(11)"[158]     2[158]- [217]ear
  216. 2240 [153]""
  217. 2250 [153][166]7)"open(NULL)elect by (NULL)ressing 1open or 2open"
  218. 2260 [142]
  219. 2295 :
  220. 2296 [143] **************
  221. 2297 [143]  month select
  222. 2298 [143] **************
  223. 2299 :
  224. 2300 [141] 1900: [143] *** clear text area ***
  225. 2305 :
  226. 2310 [153][166]11)"sys  (NULL)onth lenalendar"
  227. 2320 [153][166]11)"  (NULL)elect a month"
  228. 2325 [153][166]11)"    by number"
  229. 2330 [153][166]11)"  from this list"
  230. 2335 [153][166]11)"  and press <len(NULL)>"
  231. 2340 [153]"";
  232. 2350 [129] x[178]1[164]4
  233. 2360 [153]" "x"cmdopen. ";
  234. 2365 pt$[178][200](mnth$(x)[170]"       ",8)
  235. 2370 [153]pt$;
  236. 2375 [153]" "x[170]4"cmdopen. ";
  237. 2380 pt$[178][200](mnth$(x[170]4)[170]"       ",7)
  238. 2385 [153]pt$;
  239. 2387 [153]"";: [139] x[170]8[178]9 [167] [153]" ";
  240. 2390 [153]x[170]8"cmdopen. ";
  241. 2395 pt$[178]mnth$(x[170]8)
  242. 2400 [153]pt$
  243. 2410 [130]
  244. 2411 :                         
  245. 2415 [153][166]16)"sys->     waitsys <-cmdcmdcmdcmdcmdcmd";
  246. 2420 ml[178]2: [141] 5000: [143] *** get kbd input ***
  247. 2421 :
  248. 2425 [139] ([197](t$)[177]12) [176] ([197](t$)[179]1) [167] [153]"cmdcmd  cmdcmd";: [137] 2420
  249. 2430 mn[178][197](t$): mnth$[178]mnth$(mn)
  250. 2495 :
  251. 2496 [143] ***************
  252. 2497 [143]  year calendar
  253. 2498 [143] ***************
  254. 2499 :
  255. 2500 [141] 1900: [143] *** clear text area ***
  256. 2505 :
  257. 2510 [139] mnth$[178]"" [167] mnth$[178]"(NULL)ear lenalendar"
  258. 2515 date$[178]mnth$
  259. 2520 [141] 1800: [143] *** pad the date ***
  260. 2525 :
  261. 2560 [153][166]11)"sys"date$
  262. 2570 [153][166]11)"  (NULL)elect a year"
  263. 2572 [153][166]11)"chr$reater than  1752"
  264. 2574 [153][166]14)"sys->       waitsys <-cmdcmdcmdcmdcmdcmdcmdcmd";
  265. 2580 ml[178]4: [141] 5000: [143] *** kbd input ***
  266. 2582 yr[178][197](t$)
  267. 2584 [139] yr[179]1752 [167] [129] x[178]1[164][195](t$): [153]"cmd cmd";: [130]: [137] 2580
  268. 2590 [142]
  269. 2595 :
  270. 2596 [143] ***********
  271. 2597 [143]  prompt #2
  272. 2598 [143] ***********
  273. 2600 [141] 1900: [143] *** clear text area ***
  274. 2605 :
  275. 2610 [153][166]11)"sys"date$
  276. 2620 [153][166]11)"   (NULL)elect one:"
  277. 2630 [153][166]11)"   1sys- (NULL)creen"
  278. 2640 [153][166]11)"   2sys- (NULL)rinter"
  279. 2650 [153][166]11)"   3sys- right$ncorrect"
  280. 2660 [142]
  281. 2695 :
  282. 2696 [143] *****************
  283. 2697 [143]  prompt for lptr
  284. 2698 [143] *****************
  285. 2699 :
  286. 2700 [141] 1900: [143] *** clear text area ***
  287. 2705 :
  288. 2710 [153][166]11)"sys  (NULL)rinter (NULL)utput"
  289. 2720 [153][166]11)"sys 1sys- (NULL)rinter ready"
  290. 2730 [153][166]11)"sys 2sys- (NULL)ot ready"
  291. 2740 [142]
  292. 2795 :
  293. 2796 [143] ****************
  294. 2797 [143]  lptr not ready
  295. 2798 [143] ****************
  296. 2799 :
  297. 2800 [141] 1900: [143] *** clear text area ***
  298. 2805 :
  299. 2810 [153][166]11)"sys  (NULL)(NULL)(NULL)(NULL) not ready"
  300. 2820 [153][166]11)"    lenheck the"
  301. 2830 [153][166]11)" printer's (NULL)(NULL)/(NULL)ascasc"
  302. 2840 [153][166]11)" switch and paper"
  303. 2850 [153][166]11)"      supply."
  304. 2855 :
  305. 2860 [129] c[178]1[164]2000: [130]
  306. 2870 [142]
  307. 2895 :
  308. 2896 [143] **********************
  309. 2897 [143]  dump days to printer
  310. 2898 [143] **********************
  311. 2899 :
  312. 2900 [152]4,[199](10)[199](10)
  313. 2905 d$[178]mnth$(bm)[170]", "[170]year$
  314. 2910 z[178][181]((40[171][195](d$))[173]2)
  315. 2920 [152]4,[199](14);"";[166]z);d$;[199](15);[199](10): [143] *** page title ***
  316. 2930 [152]4,""[166]5)p1$p2$
  317. 2935 [152]4,""[166]5)"(NULL)  (NULL)unday (NULL)  (NULL)onday (NULL) (NULL)uesday (NULL)";
  318. 2940 [152]4,"(NULL)ednesday(NULL) (NULL)hursday(NULL)  ascriday (NULL) (NULL)aturday(NULL)"
  319. 2950 [152]4,""[166]5)p3$p4$
  320. 2955 :
  321. 2960 [139] day(1)[178]0 [167] [152]4,""[166]5);: [137] 2990
  322. 2965 :
  323. 2970 b[178]day(1): [152]4,""[166]5);
  324. 2975 [129] x[178]1[164]b
  325. 2980 [152]4,"(NULL)         ";
  326. 2985 [130]
  327. 2990 d[178]1
  328. 3000 d$[178][196](d): [139] [195](d$)[177]2 [167] d$[178][201](d$,2)
  329. 3005 [152]4,"(NULL) ";[199](14);d$;[199](15);"    ";
  330. 3010 d[178]d[170]1
  331. 3020 [139] d[177]eom [167] 3050
  332. 3030 b[178]day(d): [139] b[178]0 [167] [152]4,"(NULL)": [141] 3100
  333. 3040 [137] 3000
  334. 3045 :
  335. 3050 [139] b[179][177]6 [167] [141] 3160: [143] *** finish row ***
  336. 3052 [152]4,"(NULL)"
  337. 3055 [129] x[178]1[164]5
  338. 3060 [152]4,""[166]5)p7$p8$
  339. 3070 [130]
  340. 3080 [152]4,""[166]5)p5$p6$
  341. 3090 [152]4,[199](12): [142]
  342. 3095 :
  343. 3096 [143] **********************
  344. 3097 [143]  finish line of boxes
  345. 3098 [143] **********************
  346. 3099 :
  347. 3100 [129] x[178]1[164]4
  348. 3110 [152]4,""[166]5)p7$p8$
  349. 3120 [130]
  350. 3130 [152]4,""[166]5)p7$p8$
  351. 3135 [152]4,""[166]5)p3$p4$
  352. 3140 [152]4,""[166]5);
  353. 3150 [142]
  354. 3155 :
  355. 3156 [143] *********************
  356. 3157 [143]  finish row of boxes
  357. 3158 [143] *********************
  358. 3159 :
  359. 3160 [129] x[178]b[164]5
  360. 3165 [152]4,"(NULL)         ";
  361. 3170 [130]
  362. 3190 [142]
  363. 4095 :
  364. 4995 :
  365. 4996 [143] ***********
  366. 4997 [143]  kbd input
  367. 4998 [143] ***********
  368. 4999 :
  369. 5000 ct[178]0: t$[178]""
  370. 5010 [161] k$: [139] k$[178]"" [167] 5010
  371. 5020 [139] k$[178][199](13) [167] 5090
  372. 5030 [139] k$[179][177][199](20) [167] 5060
  373. 5040 [139] ct[178]0 [167] 5010
  374. 5050 ct[178]ct[171]1: t$[178][200](t$,ct): [153]"cmd cmd";: [137] 5010
  375. 5060 [139] ct[178]ml [167] 5010
  376. 5070 [139] (k$[179]"0") [176] (k$[177]"9") [167] 5010
  377. 5080 ct[178]ct[170]1: t$[178]t$[170]k$: [153]k$;: [137] 5010
  378. 5090 [139] ct[178]0 [167] 5010
  379. 5100 [142]
  380. 5995 :
  381. 5996 [143] ********************
  382. 5997 [143]  calendar algorithm
  383. 5998 [143] ********************
  384. 5999 :
  385. 6000 eom[178]maxday(mn)
  386. 6010 [139] mn [179][177] 2 [167] 6040
  387. 6020 day[178]29: mn[178]12: yr[178]yr[171]1: [141] 6080
  388. 6025 t0[178]t: day[178]1: mn[178]1: yr[178]yr[170]1: [141] 6080: mn[178]2
  389. 6030 [139] t [178] t0 [167] eom [178] 28: [143] *** no leap year ***
  390. 6040 mn[178]mn[171]2: [139] (mn[179]1) [176] (mn[177]10) [167] mn[178]mn[170]12: yr[178]yr[171]1
  391. 6050 cent[178][181](yr[173]100)
  392. 6060 yr[178]yr[171](cent[172]100)
  393. 6070 [129] day[178]1[164] eom: [141] 6080: days(day)[178]t
  394. 6075 [130]: [142]
  395. 6080 ly[178][181](yr[173]4): lc[178][181](cent[173]4)
  396. 6090 t[178](2.6[172]mn[171].2)[170]day[170]yr[170]ly[170]lc[171]cent[171]cent
  397. 6100 t[178][181](t)[171]([181](t[173]7)[172]7):[142]
  398.