Discordian date: Difference between revisions

Content added Content deleted
m (→‎{{header|Perl}}: Fix link: Perl 6 --> Raku)
(Add 8080 assembly version)
Line 5: Line 5:
Convert a given date from the   [[wp:Gregorian calendar|Gregorian calendar]]   to the   [[wp:Discordian calendar|Discordian calendar]].
Convert a given date from the   [[wp:Gregorian calendar|Gregorian calendar]]   to the   [[wp:Discordian calendar|Discordian calendar]].
<br><br>
<br><br>

=={{header|8080 Assembly}}==

This program is written to run under CP/M, and it takes a Gregorian date as an argument on the command line, in <code>DDMMYYYY</code> format.

<lang 8080asm> ;; On the 44th day of Discord in the YOLD 3186, ddate
;; has finally come to CP/M.
bdos: equ 5 ; CP/M syscalls
puts: equ 9
putch: equ 2
fcb: equ 5ch
month: equ fcb + 1 ; use the FCB as the date argument
day: equ month + 2
year: equ day + 2
org 100h
;; CP/M will try to parse the command line arguments as if
;; they are filenames. As luck would have it, MMDDYYYY is
;; 8 characters. It would be a shame not to use this.
lxi h,month ; check that the 'filename' is
lxi b,0800h ; all digits (and zero out C)
argcheck: mov a,m
call isdigit
jnc argerror ; if not, give an error and exit
inx h
dcr b
jnz argcheck
;; Fix the year (add 1166 to it, digit by digit)
lxi d,year + 3
lxi h,yearoffset + 3
mvi b,4
ana a ; Clear carry
yeardgt: ldax d ; Get digit
adc m ; Add offset digit
cpi '9' + 1 ; Did we overshoot?
cmc ; Carry is opposite of what we need
jnc yearnextdgt ; No carry = no adjustment
sui 10 ; Compensate
stc ; Carry the one
yearnextdgt: stax d ; Save digit
dcx d ; Look at more significant digit
dcx h
dcr b ; Until we're out of digits
jnz yeardgt
lxi h,year + 4 ; Terminate the year with a $
mvi m,'$' ; for easy output.
;; Is it St. Tib's Day?
lxi d,month ; Check month and day
lxi h,leap ; Against '0229'
mvi b,4
tibcheck: ldax d ; Get date byte
cmp m ; Match against leap day
jnz notibs ; No match = not Tibs
inx h
inx d
dcr b
jnz tibcheck ; if they all match it _is_ Tibs
;; Print "St. Tib's Day in the YOLD NNNN."
lxi d,tibsday
call outs ; fall through into printyear
;; Print " in the YOLD NNNN."
printyear: lxi d,yold
call outs
lxi d,year
jmp outs ; if Tibs, this ends the program
;; It isn't St. Tib's Day. We'll need to do real work :(
notibs: lxi h,month ; Find days at beginning of month
call parsenum ; (not counting Tibs)
dcr a ; subtract one (table is 0-indexed)
cpi 12 ; check that month < 12
jnc argerror ; otherwise, argument error
ana a ; multiply month by 2
ral ; (entries are 2 bytes wide)
lxi h,monthdays ; get days table
mov d,c ; look up the entry (C is zero here)
mov e,a
dad d
mov e,m ; load the 16-bit entry into DE
inx h
mov d,m
lxi h,day ; Find day number
call parsenum
mov l,a ; Add it to the start of the month
mov h,c ; (C is still zero) - to get the day
dad d ; number (still not counting Tibs)
dcx h ; One less (so we have day numbering at 0)
push h ; Keep day number
lxi d,-365 ; Make sure it isn't >365
dad d
jc argerror ; Give an error otherwise
pop h ; Restore day number
push h ; Keep it around
;; Calculate Erisian weekday
lxi d,-5 ; It's not worth it being clever here
weekcalc: dad d
jc weekcalc
lxi d,5
dad d
mov b,l
lxi h,weekdays ; Print the day of the week
call strselect
lxi d,commaday ; Print ", day "
call outs
;; Calculate season and season day number
pop h ; Restore day number
mvi b,-1 ; B will be season
lxi d,-73 ; L will be day
seasoncalc: inr b ; One season further on
dad d ; Is 73 days less
jc seasoncalc
lxi d,73 ; Correct overshoot
dad d
mov h,b ; H:L = season:day
inr l ; One based for output
push h ; Push season and day
mov a,l ; Print day of season
mvi c,'0'-1 ; Tens digit in C
seasondgts: inr c
sui 10
jnc seasondgts
adi '0' + 10 ; Ones digit in A
mov e,c ; Tens digit
call oute
mov e,a ; Ones digit
call oute
lxi d,of ; Print " of "
call outs
pop b ; Retrieve season:day
push b
lxi h,seasons ; Print the season name
call strselect
call printyear ; "... in the YOLD NNNN ..."
;; Is there any reason to celebrate? (day=5 or day=50)
pop b ; Retrieve season:day
mov a,c ; Day.
cpi 5 ; is it 5?
jz party ; Then we party
cpi 50 ; otherwise, is it 50?
rnz ; If not, we're done
party: push b ; Keep day
lxi d,celebrate ; "... Celebrate ..."
call outs
pop b ; Retrieve day
push b
lxi h,holydays5 ; Get holyday from 5 or 50 table
mov a,c
cpi 50
jnz dayname
lxi h,holydays50
dayname: call strselect ; the season is still in B
lxi d,xday
pop b ; Retrieve day once more
mov a,c
cpi 50
jnz outs ; Print 'day' or 'flux' depending
lxi d,xflux
jmp outs
;; Parse the 2-digit number in HL. Return in B (and A)
parsenum: mvi b,0 ; zero accumulator
call parsedigit ; this runs it twice
parsedigit: mov a,b ; B *= 10
add a
mov b,a
add a
add a
add b
add m ; Add the digit
sui '0' ; Subtract '0'
mov b,a
inx h
ret
;; Print the B'th string from HL
strselect: mvi a,'$'
strsearcho: dcr b
jm strfound
strsearchi: cmp m
inx h
jnz strsearchi
jmp strsearcho
strfound: xchg
jmp outs
;; Print the argument error, and exit
argerror: lxi d,argfmt
;; Print the string in DE and exit
error: call outs
rst 0
;; Returns with carry flag set if A is a digit ('0'-'9').
isdigit: cpi '0'
cmc
rnc
cpi '9' + 1
ret
;; Print the string in D.
outs: mvi c,puts
jmp bdos
;; Print character in E, keeping registers.
oute: push psw
push b
push d
push h
mvi c,putch
call bdos
pop h
pop d
pop b
pop psw
ret
;; Accumulated days at start of Gregorian months
;; (in a non-leap year)
monthdays: dw 0,31,59,90,120,151,181,212,243,273,304,334
;; Difference between Gregorian and Erisian year count
;; (we don't need to bother with the year otherwise)
yearoffset: db 1,1,6,6
;; This is matched to MMDD to handle St. Tib's Day
leap: db '0229'
;; Strings
argfmt: db 'DDATE MMDDYYYY$'
weekdays: db 'Sweetmorn$Boomtime$Pungenday$Prickle-Prickle$'
db 'Setting Orange$'
commaday: db ', day $'
of: db ' of $'
seasons: db 'Chaos$Discord$Confusion$Bureaucracy$The Aftermath$'
celebrate: db ': celebrate $'
holydays5: db 'Mung$Mojo$Sya$Zara$Mala$'
xday: db 'day!$'
holydays50: db 'Chao$Disco$Confu$Bure$Af$'
xflux: db 'flux!$'
tibsday: db 'Saint Tib',39,'s Day$'
yold: db ' in the YOLD $'
</lang>

{{out}}

<pre>A>ddate 04272020
Boomtime, day 44 of Discord in the YOLD 3186
A>ddate 09261995
Prickle-Prickle, day 50 of Bureaucracy in the YOLD 3161: celebrate Bureflux!
A>ddate 02291996
Saint Tib's Day in the YOLD 3162
A>ddate 07222011
Pungenday, day 57 of Confusion in the YOLD 3177
A>ddate 01052005
Setting Orange, day 05 of Chaos in the YOLD 3171: celebrate Mungday!
</pre>


=={{header|Ada}}==
=={{header|Ada}}==
Retrieved from "https://rosettacode.org/wiki/Discordian_date"