RosettaCodeData/Task/Discordian-date/PowerBASIC/discordian-date.basic

66 lines
2.0 KiB
Plaintext

#COMPILE EXE
#DIM ALL
'change this for systems that use a different character
$DATESEP = "-"
FUNCTION day(date AS STRING) AS LONG
'date is same format as date$
DIM tmpdash1 AS LONG, tmpdash2 AS LONG
tmpdash1 = INSTR(date, $DATESEP)
tmpdash2 = INSTR(-1, date, $DATESEP)
FUNCTION = VAL(MID$(date, tmpdash1 + 1, tmpdash2 - tmpdash1 - 1))
END FUNCTION
FUNCTION month(date AS STRING) AS LONG
'date is same format as date$
DIM tmpdash AS LONG
tmpdash = INSTR(date, $DATESEP)
FUNCTION = VAL(LEFT$(date, tmpdash - 1))
END FUNCTION
FUNCTION year(date AS STRING) AS LONG
'date is same format as date$
DIM tmpdash AS LONG
tmpdash = INSTR(-1, date, $DATESEP)
FUNCTION = VAL(MID$(date, tmpdash + 1))
END FUNCTION
FUNCTION julian(date AS STRING) AS LONG
'date is same format as date$
'doesn't account for leap years (not needed for ddate)
'days preceding 1st of month
' jan feb mar apr may jun jul aug sep oct nov dec
DATA 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334
FUNCTION = VAL(READ$(month(date))) + day(date)
END FUNCTION
FUNCTION PBMAIN () AS LONG
'Season names
DATA "Chaos", "Discord", "Confusion", "Bureaucracy", "The Aftermath"
'Weekdays
DATA "Setting Orange", "Sweetmorn", "Boomtime", "Pungenday", "Prickle-Prickle"
DIM dyear AS LONG, dseason AS STRING, dday AS LONG, dweekday AS STRING
DIM tmpdate AS STRING, jday AS LONG, result AS STRING
IF LEN(COMMAND$) THEN
tmpdate = COMMAND$
ELSE
tmpdate = DATE$
END IF
dyear = year(tmpdate) + 1166
IF (2 = month(tmpdate)) AND (29 = day(tmpdate)) THEN
result = "Saint Tib's Day, " & STR$(dyear) & " YOLD"
ELSE
jday = julian(tmpdate)
dseason = READ$((jday \ 73) + 1)
dday = (jday MOD 73)
IF 0 = dday THEN dday = 73
dweekday = READ$((jday MOD 5) + 6)
result = dweekday & ", " & dseason & " " & TRIM$(STR$(dday)) & ", " & TRIM$(STR$(dyear)) & " YOLD"
END IF
? result
END FUNCTION