fork download
copy 
  1.  
  2. 0 CONSTANT ЯБЛОКИ
  3. 1 CONSTANT ВИНОГРАД
  4. 2 CONSTANT ПЕРСИКИ
  5.  
  6. : ARRAY:  ( n "<spaces>name" -- )
  7.     CREATE
  8.         DUP ,
  9.         CELLS ALLOT
  10.     DOES>
  11.         2DUP @ >= ABORT" LOHPIDR!!!"
  12.         CELL+ SWAP CELLS + ;
  13.  
  14. 3 ARRAY: ЦЕНА
  15.  
  16. \ FIXED PITHU
  17. 1090   ЯБЛОКИ ЦЕНА !
  18. 2090 ВИНОГРАД ЦЕНА !
  19. 3090  ПЕРСИКИ ЦЕНА !
  20.  
  21. 3 ARRAY: ПОДСЧЁТ-ЦЕНЫ
  22.  
  23. :NONAME  ( кол-во цена-за-шт. -- цена )
  24.     OVER 100 > IF 80 100 */ THEN  100 */ ;
  25. ЯБЛОКИ ПОДСЧЁТ-ЦЕНЫ !
  26.  
  27. :NONAME  ( кол-во цена-за-шт. -- цена )
  28.     SWAP DUP 200 / 100 * - 100 */ ;
  29. ВИНОГРАД ПОДСЧЁТ-ЦЕНЫ !
  30.  
  31. : ПОДСЧЁТ-ЦЕНЫ-ПО-УМОЛЧАНИЮ  ( кол-во цена-за-шт. -- цена )  100 */ ;
  32.  
  33. ' ПОДСЧЁТ-ЦЕНЫ-ПО-УМОЛЧАНИЮ ПЕРСИКИ ПОДСЧЁТ-ЦЕНЫ !
  34.  
  35. : ПОСЧИТАТЬ-ЦЕНУ-ЗА-ТОВАР  ( кол-во вид-товара -- цена )
  36.     DUP ЦЕНА @ SWAP ПОДСЧЁТ-ЦЕНЫ @ EXECUTE ;
  37.  
  38. : ИТОГО  ( a-addr u -- цена )
  39.     0 -ROT
  40.     2* CELLS OVER + SWAP ?DO
  41.         I 2@ ПОСЧИТАТЬ-ЦЕНУ-ЗА-ТОВАР +
  42.     2 CELLS +LOOP ;
  43.  
  44. : ПЕЧАТЬ  ( u -- )
  45.     0 <#  # # [CHAR] . HOLD #S #> TYPE CR ;
  46.  
  47. CREATE ТЕСТ1  ЯБЛОКИ , 0000 , ВИНОГРАД , 0100 , ПЕРСИКИ , 0100 ,
  48. CREATE ТЕСТ2  ЯБЛОКИ , 0000 , ВИНОГРАД , 0200 , ПЕРСИКИ , 0100 ,
  49. CREATE ТЕСТ3  ЯБЛОКИ , 0400 , ВИНОГРАД , 0300 , ПЕРСИКИ , 0000 ,
  50. CREATE ТЕСТ4  ЯБЛОКИ , 0500 , ВИНОГРАД , 0000 , ПЕРСИКИ , 0800 ,
  51.  
  52. ТЕСТ1 3 ИТОГО ПЕЧАТЬ
  53. ТЕСТ2 3 ИТОГО ПЕЧАТЬ
  54. ТЕСТ3 3 ИТОГО ПЕЧАТЬ
  55. ТЕСТ4 3 ИТОГО ПЕЧАТЬ
  56.  
  57.  
Success #stdin #stdout 0s 4384KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
51.80
51.80
76.68
290.80
https://ideone.com/Ny2iG7
language:
Forth (gforth 0.7.3)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!