Subversion Repositories Kolibri OS

Rev

Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1. DECIMAL
  2.  S" /rd/1/menuet.f" INCLUDED
  3.  
  4. : not_emit
  5.         emit_proc DUP @ NOT SWAP ! ;
  6.  
  7. new_reg wnd_size
  8.  
  9. CREATE Music $3090 , \ $90 C, $30 C, 0 C,
  10.  
  11. 73 CONSTANT img.width
  12. 22 CONSTANT img.height
  13. CREATE raw  img.width img.height * 3 * 16 + ALLOT
  14.  
  15. : my_wnd
  16.   12 ax 1 bx sysv DROP $805080D0 DUP $02AABBCC 200 150 << 200 DUP << 0
  17.         sys6 2 bx sysv 2DROP
  18.   $10DDEEFF $" ˆŒ… Žƒ€ŒŒ›" COUNT 8 DUP sys_print
  19.   0 $"  ¦¬¨â¥ «î¡ãî ª« ¢¨èã" COUNT 8 30 sys_print
  20.   $6688DD 1 5 12 << 200 19 - 12 << 8 sys5 DROP
  21.   30 DUP << img.width img.height << raw 12 + 7 sys4 ;
  22.  
  23. : my_wnd_resize
  24.         200 dx 50 si 67 ax -1 DUP bx cx sysv DROP ;
  25.  
  26. : my_key
  27.         2 sys1 8 RSHIFT DUP 96 = IF not_emit DROP ELSE Music DUP si 1+ C!
  28.  55 DUP ax bx sysv DROP THEN ;
  29.  
  30. : my_btn
  31.         17 sys1 8 RSHIFT ." Pressed button #" DUP . CR 1 = IF BYE THEN ;
  32.  
  33. CREATE handlers ' my_wnd , ' my_key , ' my_btn ,
  34.  
  35. VARIABLE hnd
  36.  
  37. : msg_loop_console ( subs -- )
  38.         CR DUP hnd ! @EXECUTE  my_wnd_resize
  39.         0 emit_proc !
  40.         BEGIN
  41.         10 sys1 ?DUP
  42.         IF
  43.           1-
  44.     CELLS hnd @ + @EXECUTE
  45.     emit_proc @
  46.     IF
  47.         WINDOW KEY 96 =
  48.         IF
  49.                 not_emit hnd @ @EXECUTE  my_wnd_resize
  50.         ELSE
  51.           EXIT
  52.         THEN
  53.     THEN
  54.   THEN
  55.   AGAIN ;
  56.  
  57. CREATE gif 600 ALLOT
  58.  
  59.  
  60. : new_me ( new main loop)
  61.   gif DUP $" /rd/1/Menu.gif" COUNT READ 2DROP
  62.   gif raw READ_GIF .
  63.   ;
  64.  
  65. new_me handlers msg_loop_console WORDS
  66.  
  67. ABORT
  68.  
  69.  
  70.         : ENDOF ( orig1 #of -- orig2 #of )
  71.           >R    ( ïåðåìåñòèòü ñî ñòåêà â ñëó÷àå, åñëè )
  72.                 ( ñòåê ïîòîêà óïðàâëåíèÿ ýòî ñòåê äàííûõ. )
  73.           POSTPONE ELSE
  74.           R>    ( ìû äîëæíû òåïåðü âåðíóòü ñ÷åò÷èê íàçàä )
  75.         ; IMMEDIATE
  76.  
  77.         : ENDCASE  ( orig1..orign #of -- )
  78.                
  79.           POSTPONE DROP  ( óäàëèòü case ïàðàìåòð )
  80.           0 ?DO
  81.             POSTPONE THEN
  82.           LOOP
  83.         ; IMMEDIATE
  84.  
  85. [THEN]
  86.  
  87.           : SS2   ( N ---> S:ÑÓÌÌÀ ÊÂÀÄÐÀÒÎÂ ÎÒ 1 ÄÎ N)
  88.               0  SWAP           ( 0,N         S[0]=0  )
  89.               1+  1             ( S[0],N+1,1          )
  90.                     DO   I      ( S[I-1],I            )
  91.                       DUP * +       ( S[I] S[I]=S[I-1]+I*I)
  92.                     LOOP  ;     ( S[N]   )
  93.  
  94.  
  95.  5 SS2 . CR
  96.  
  97. : test 10 0 ?DO I . LEAVE LOOP 4 ;
  98. test
  99.  
  100.     : priem ( N:ÍÎÌÅÐ ÄÍß->)   CASE
  101.         3 OF ." nepriemn"  ENDOF
  102.  
  103.         1 OF ." priemn" ENDOF
  104.  
  105.         6 OF ." holiday" ENDOF
  106.  
  107.         CR . ." - day #?" ABORT
  108.         ( ENDCASE ) ." day" ;
  109.  
  110.