aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Add tasks for all the new languages

Browse source
This commit is contained in:
Tina Müller 2016-12-05 23:44:36 +01:00
parent 9dc3c2bb62
commit bba7bfd280
13208 changed files with 134745 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

36
Task/Calendar---for-REAL-programmers/XLISP/calendar---for-real-programmers.xlisp Normal file
View file

@ -0,0 +1,36 @@
(SETQ YR 1969)
(SETQ M #("JANUARY" "FEBRUARY" "MARCH" "APRIL" "MAY" "JUNE" "JULY" "AUGUST" "SEPTEMBER" "OCTOBER" "NOVEMBER" "DECEMBER"))
(SETQ ML #(31 28 31 30 31 30 31 31 30 31 30 31))
(SETQ WD #("SU" "MO" "TU" "WE" "TH" "FR" "SA"))
(IF (AND (= (REM YR 4) 0) (OR (/= (REM YR 100) 0) (= (REM YR 400) 0))) (VECTOR-SET! ML 1 29))
(SETQ D (REM (+ 1 (+ (* 5 (REM (- YR 1) 4)) (* 4 (REM (- YR 1) 100)) (* 6 (REM (- YR 1) 400)))) 7))
(TERPRI)
(DO ((I 0 (+ I 1))) ((> I 60))
(PRINC " "))
(PRINC "SNOOPY CALENDAR ")
(PRINC YR)
(TERPRI)
(DO ((I 0 (+ I 1))) ((> I 11))
(TERPRI)
(DO ((J 0 (+ J 1))) ((> J 65))
(PRINC " "))
(PRINC (VECTOR-REF M I))
(TERPRI)
(PRINC " ")
(DO ((J 0 (+ J 1))) ((> J 6))
(DO ((K 0 (+ K 1))) ((> K 14))
(PRINC " "))
(PRINC (VECTOR-REF WD J))
(PRINC " "))
(TERPRI)
(DO ((J 0 (+ J 1))) ((> J 6))
(IF (< J D) (DO ((K 0 (+ K 1))) ((> K 18)) (PRINC " "))))
(DO ((J 1 (+ J 1))) ((> J (VECTOR-REF ML I)))
(PRINC " ")
(IF (< J 10) (PRINC " "))
(DO ((K 0 (+ K 1))) ((> K 14))
(PRINC " "))
(PRINC J)
(SETQ D (+ D 1))
(IF (> D 6) (TERPRI))
(IF (> D 6) (SETQ D 0))))