Subversion Repositories Kolibri OS

DECIMAL

 S" /sys/menuet.f" INCLUDED

: not_emit

	emit_proc DUP @ NOT SWAP ! ;

new_reg wnd_size

CREATE Music $3090 , \ $90 C, $30 C, 0 C,

73 CONSTANT img.width

22 CONSTANT img.height

CREATE raw  img.width img.height * 3 * 16 + ALLOT

: my_wnd

  12 ax 1 bx sysv DROP $805080D0 DUP $02AABBCC 200 150 << 200 DUP << 0

 	sys6 2 bx sysv 2DROP

  $10DDEEFF $" ������ ���������" COUNT 8 DUP sys_print

  $6688DD 1 5 12 << 200 19 - 12 << 8 sys5 DROP

  30 DUP << img.width img.height << raw 12 + 7 sys4 ;

: my_wnd_resize

	200 dx 50 si 67 ax -1 DUP bx cx sysv DROP ;

: my_key

	2 sys1 8 RSHIFT DUP 96 = IF not_emit DROP ELSE Music DUP si 1+ C!

 55 DUP ax bx sysv DROP THEN ;

: my_btn

	17 sys1 8 RSHIFT ." Pressed button #" DUP . CR 1 = IF BYE THEN ;

CREATE handlers ' my_wnd , ' my_key , ' my_btn ,

VARIABLE hnd

: msg_loop_console ( subs -- )

	CR DUP hnd ! @EXECUTE  my_wnd_resize

	BEGIN

	10 sys1 ?DUP

	IF

	  1-

    CELLS hnd @ + @EXECUTE

    emit_proc @

    IF

    	WINDOW KEY 96 =

    	IF

    		not_emit hnd @ @EXECUTE  my_wnd_resize

    	ELSE

    	  EXIT

    	THEN

    THEN

  THEN

  AGAIN ;

CREATE gif 600 ALLOT

: new_me ( new main loop)

  gif DUP $" /sys/Menu.gif" COUNT READ 2DROP

  gif raw READ_GIF .

  ;

new_me handlers msg_loop_console WORDS

ABORT

        : ENDOF ( orig1 #of -- orig2 #of )

          >R    ( ����������� �� ����� � ������, ���� )

                ( ���� ������ ���������� ��� ���� ������. )

          POSTPONE ELSE

          R>    ( �� ������ ������ ������� ������� ����� )

        ; IMMEDIATE

        : ENDCASE  ( orig1..orign #of -- )

          POSTPONE DROP  ( ������� case �������� )

            POSTPONE THEN

          LOOP

        ; IMMEDIATE

[THEN]

          : SS2   ( N ---> S:����� ��������� �� 1 �� N)

              1+  1             ( S[0],N+1,1          )

                    DO   I      ( S[I-1],I            )

                      DUP * +       ( S[I] S[I]=S[I-1]+I*I)

                    LOOP  ;     ( S[N]   )

 5 SS2 . CR

: test 10 0 ?DO I . LEAVE LOOP 4 ;

test

    : priem ( N:����� ���->)   CASE

        3 OF ." nepriemn"  ENDOF

        1 OF ." priemn" ENDOF

        6 OF ." holiday" ENDOF

        CR . ." - day #?" ABORT

        ( ENDCASE ) ." day" ;