Круглые даты

Обсуждение программ nnCron и nnCron LITE

Круглые даты

Postby AlikasS » Sat, 01 Nov 2008, 03:39

взято с форума http://fforum.winglion.ru
Code: Select all
MODULE: BIRTHDAY_AND_DATE2
: >DAY ( DD MM YY -- U ) 1900 - SWAP DUP 3 < IF 12 + SWAP 1- SWAP THEN 1+ 153 5 */ SWAP 1461 4 */ + + 122 - ;
: DAY> ( U -- YY MM DD ) 4 1461 */MOD SWAP DUP 0= IF DROP 1- 1464 THEN
3 + 4 / 122 + 5 153 */MOD SWAP 4 + 5 / >R 1- DUP 12 > IF 12 - SWAP 1+ SWAP THEN SWAP 1900 + SWAP R> ;
: JUB ( U -- F ) TRUE SWAP BEGIN DUP 10 > WHILE 10 /MOD SWAP IF 2DROP FALSE EXIT THEN REPEAT DROP ;
0 VALUE BIRTHDAY
: DAT. DUP DAY>
 0 <# # # #> TYPE
\ SPACE 1- 3 * S" JanFebMarAprMayJunJulAugSepOctNovDec" DROP + 3 TYPE
SPACE 1- 3 * S" ЯнвФврМарАпрМайИюнИюлАвгСнтОктНояДек" DROP + 3 TYPE
 SPACE .
\ SPACE 3 + 7 MOD 3 * S" SunMonTueWedThiFriSat" DROP + 3 TYPE ."  - "
SPACE 3 + 7 MOD 3 * S" ВскПндВтрСрдЧтвПтнСбт" DROP + 3 TYPE ."  - "
;
: CHECK ( U -- )
 DUP >R DAY> BIRTHDAY DAY> 3 ROLL =
 IF
  ROT 2DUP =
  IF
\   2OVER - DUP JUB IF CR R@ DAT. ." Years: " . ELSE DROP THEN
2OVER - DUP JUB IF CR R@ DAT. ." Лет от даты: " . ELSE DROP THEN
  THEN
\  SWAP - >R - 12 * R> + DUP JUB IF CR R@ DAT. ." Months: " . ELSE DROP THEN
 SWAP - >R - 12 * R> + DUP JUB IF CR R@ DAT. ." Месяцев от даты: " . ELSE DROP THEN
 ELSE
  2DROP 2DROP
 THEN
 R@ BIRTHDAY -
\ DUP 7 /MOD SWAP 0= IF DUP JUB IF CR R@ DAT. ." Weeks: " . ELSE DROP THEN ELSE DROP THEN
DUP 7 /MOD SWAP 0= IF DUP JUB IF CR R@ DAT. ." Недель от даты: " . ELSE DROP THEN ELSE DROP THEN
\ DUP JUB IF CR R@ DAT. ." Days: " . ELSE DROP THEN
DUP JUB IF CR R@ DAT. ." Дней от даты: " . ELSE DROP THEN
 R> DROP
;
EXPORT
\ в консоль
: LIFE ( D1 M1 Y1 -- ) >DAY DUP TO BIRTHDAY DUP 40000 + SWAP 1+ DO I CHECK LOOP ;
\ в файл
: ~LIFE { a u -- } ( D1 M1 Y1 S" filename" -- S" filename" )
a u
H-STDOUT >R
H-STDERR >R
   ModuleDirName 2SWAP S+ 2DUP DELETE-FILE DROP
   R/W MAKE-FILE DROP DUP TO H-STDOUT TO H-STDERR
    LIFE
   H-STDOUT CLOSE-FILE DROP
R> TO H-STDERR
R> TO H-STDOUT
a u
;
;MODULE

можно пдключить как плагин или между <% %>
и пользоваться например
Code: Select all
#( разные_даты
NoActive
USER-VALUE fn
NoLog
Action:
 WIN-INPUT-TEXT: "Расчет круглых дат" "Введите начальную дату%crlf%день месяц год" "08 02 1968" 0 0=
 IF
2DUP S"  - Начальная дата для расчета" S+ S" .tmp" S+ S>ZALLOC TO fn
 <TIB

get-number get-number get-number
fn ASCIIZ> ~LIFE

S" %SystemRoot%\system32\notepad.exe " EVAL-SUBST 2SWAP S+ START-APPW
fn ASCIIZ> FDELETE
 TIB>
 THEN
)#
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

Return to nnCron forum (Russian)

Who is online

Users browsing this forum: No registered users and 4 guests