Вот бы написать на форте программу готорая бы

Jelsay

тема выделена из "юбилейчиков", пока остается в этом разделе,
но мало ли, вдруг чего из этого получится?
WingLion

Вот бы написать на форте программу готорая бы высчитывала все ближайжие круглые даты и юбилеи с дня рождения данного человека не только в годах, но и в днях, неделях, месяцах..

скажем - не 8.33 года, а 100 месяцев
- не 19.23 с небольшим лет, а 1000 недель
- не 27.39 года, а 10000 дней

полукруглые даты 500, 5000 и т.п. тоже бы неплохо было бы учитывать

а если еще к тому же переключать системы счисления - то вообще - ух

____________________________________________
Привет всем - меня зовут Jelsay, я тоже люблю Forth

VoidVolker

Jelsay ну вот это уже надо в конкурс.

Jelsay

VoidVolker не знаю насчёт конкурса, но предлагаемая програмка могла бы быть достаточно забавной и могла бы способствовать упоминанию о языке Форт в массах..
При условии конечно же если она была бы написана на Форте

Forthware

Вот, нацарапал. После загрузки пишем: 23 10 1955 LIFE, и получаем распечатку юбилеев на всю жизнь

Код:

: >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 . 
 SPACE 3 + 7 MOD 3 * S" SunMonTueWedThiFriSat" 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 
  THEN 
  SWAP - >R - 12 * R> + DUP JUB IF CR R@ DAT. ." Months: " . 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 JUB IF CR R@ DAT. ." Days: " . ELSE DROP THEN 
 R> DROP 
; 
: LIFE ( D1 M1 Y1 -- ) >DAY DUP TO BIRTHDAY DUP 40000 + SWAP 1+ DO I CHECK LOOP ;

VoidVolker

Код:

Days: 3
Days: 3
Days: 3
...
Years: 3
Weeks: 3
Days: 3
Years: 3  Ok ( [615].. 2055 1955 10 10 100 )

Эмм... Так и должно быть? А как тогда понять что это все значит?

Forthware

VoidVolker писал(а):

Эмм... Так и должно быть? А как тогда понять что это все значит?

У вас, скорее всего .R не правильно реализован. Я переделал код без него. Попробуйте еще раз.
ЗЫ В SPF 4.18 работает.

VoidVolker

Хорошо, работает. Моя версия спфа 418001.
Первые девять дней из этого списка думаю нужно исключить, еще бы добавить зависимость от системы счисления. И не на 100 лет вперед, а чтоб можно было задать.

Jelsay

Forthware
Спасибо за код, более всего подравилось это:

Цитата:

100 36525 */MOD SWAP DUP 0= IF DROP 1- 36600

VoidVolker

Код:

: .R  
  >R DUP >R ABS
  S>D <# #S R> SIGN #>
  R> OVER - 0 MAX SPACES TYPE
;

Forthware

Вот расширенный вариант. Проверяет все юбилеи одновременно в десятичной, шестнадцатиричной, восьмиричной и двоичной системах исчисления а также вычисляет юбилеи в "дюжинах" (dozen = 12), тоже во всех системах.
Правила пользования:

Чтобы добавить еще одну, свою систему исчисления, делаем:
3 TO JBASE

Чтобы убрать, пишем в JBASE любое либо 10 либо 8 либо 16 либо 2.

Чтобы получить распечатку юбилеев делаем:
23 10 1955 1 1 2008 1000 PERIOD
, где 23 10 1955 - дата рождения; 1 1 2008 - начало периода в котором ищем юбилеи; 1000 - длина периода в днях.

Можно также:
23 10 1955 LIFE
но ВНИМАНИЕ! листинг на всю жизнь будет ОЧЕНЬ длинным!

Код:

: >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> ;
0 VALUE BIRTHDAY
0 VALUE DATE
10 VALUE JBASE
: DAT. ( C-ADDR U1 U2 -- C-ADDR U1 U2 C-ADDR U1 U2 )
 BASE @ >R DECIMAL
 DUP 2OVER ROT DATE
 DUP DAY> 0 <# # # #> CR TYPE
 SPACE 1- 3 * S" JanFebMarAprMayJunJulAugSepOctNovDec" DROP + 3 TYPE SPACE .
 SPACE 3 + 7 MOD 3 * S" SunMonTueWedThiFriSat" DROP + 3 TYPE ."  - "
 R> BASE !
;
: EVEN ( U -- F ) TRUE SWAP BEGIN DUP BASE @ > WHILE BASE @ /MOD SWAP IF 2DROP FALSE EXIT THEN REPEAT DROP ;
: JUB1 ( U1 C-ADDR U2 -- ) BASE @ >R ROT
 DUP DECIMAL EVEN IF DAT. . TYPE THEN
 DUP HEX EVEN IF DAT. . ." hex " TYPE THEN
 DUP  8 BASE ! EVEN IF DAT. . ." octal " TYPE THEN
 DUP  2 BASE ! EVEN IF DAT. . ." binary " TYPE THEN
 JBASE 10 = JBASE 16 = OR JBASE 8 = OR JBASE 2 = OR 0=
 IF DUP JBASE BASE ! EVEN IF DAT. . ." radix " BASE @ DECIMAL . ." , " TYPE THEN THEN
 DROP 2DROP R> BASE !
;
: JUB ( U1 C-ADDR U2 -- )
 2 PICK 2 PICK 2 PICK JUB1
 S" dozens of " >R PAD R@ MOVE PAD R@ + SWAP DUP >R MOVE
 12 /MOD SWAP IF DROP R> R> 2DROP EXIT THEN
 PAD R> R> + JUB1
;
: CHECK ( -- )
 DATE DAY> BIRTHDAY DAY> 3 ROLL =
 IF
  ROT 2DUP =
  IF
   2OVER - S" years" JUB
  THEN
  SWAP - >R - 12 * R> + S" months" JUB
 ELSE
  2DROP 2DROP
 THEN
 DATE BIRTHDAY -
 DUP 7 /MOD SWAP 0= IF S" weeks" JUB ELSE DROP THEN
 S" days" JUB
;
: PERIOD ( DB MB YB DS MS YS DAYS )
 >R >DAY >R >DAY TO BIRTHDAY R> DUP R> + SWAP ?DO I TO DATE CHECK LOOP ;
: LIFE ( D1 M1 Y1 -- ) 2 PICK 2 PICK 2 PICK 40000 PERIOD ;

Forthware

Jelsay писал(а):

Спасибо за код, более всего подравилось это:

Пожалуйста. Если захотите использовать >DAY и DAY> в будущем, то помните, что они работают правильно только в диапазоне от 01 03 1900 до 28 02 2100. Если надо больше, скажите, сделаем.

Hishnik

Вот бы еще в теме отразить, что именно должна делать программа?

Kamikaze

Хищник писал(а):

Вот бы еще в теме отразить, что именно должна делать программа?

Давным давно я записал пару простых формул в Excel, и с тех пор отмечаю все дни рождения по марсианскому календарю.
И еще - самый главный день рождения в жизни: 10000 дней ! ! !
Отмечал и свой, и жены, и дни рожденья в 1000 дней обоих дочек.

Коэффициент пересчета для Марса (марсианский год): 686,98 дней
Можно еще использовать юпитерианский: 4332,589 дней (но это уже не так интересно)

А по-поводу задачи - нужен не код, а нормальная программка с пользовательским интерфейсом.

Forthware

Kamikaze писал(а):

И еще - самый главный день рождения в жизни: 10000 дней ! ! !

В какой системе счисления?

Kamikaze писал(а):

А по-поводу задачи - нужен не код, а нормальная программка с пользовательским интерфейсом.

Вот тут у Форта проблемы... Предлагаю переключиться на Дельфи. :roll:

Kamikaze

Forthware писал(а):

Kamikaze писал(а):

И еще - самый главный день рождения в жизни: 10000 дней ! ! !

В какой системе счисления?

Это обычные земные сутки - кто сказал что возраст можно только в годах считать?

10000 дней - примерно 27 с половиной лет. Кто в районе этой даты - проверьтесь, чтоб не пропустить!

Forthware писал(а):

А по-поводу задачи - нужен не код, а нормальная программка с пользовательским интерфейсом.

Вот тут у Форта проблемы... Предлагаю переключиться на Дельфи.[/quote]
Не надо Дельфи! Надо на конкретной задаче решать эту проблему форта! Да и какая проблема, когда есть WinAPI?

Forthware

Kamikaze писал(а):

Надо на конкретной задаче решать эту проблему форта!

Как?

Kamikaze писал(а):

Да и какая проблема, когда есть WinAPI?

Стрить междуморду в голом винапи всеравно что писать алгоритм в голом ассме. К тому же, винапи то есть, да вот в каждой реализации форта к нему доступ сделан по своему. Напишешь для СПФ, не пойде на Вин32Форт, и так для всех... Ну а на дельфи оно раз в 10 проще...

Вот бы написать на форте программу готорая бы

Кто сейчас на конференции