Subversion Repositories Kolibri OS

Compare Revisions

No changes between revisions

Regard whitespace Rev 4866 → Rev 4867

/programs/develop/SPForth/meforth_samples/autoload.f
0,0 → 1,41
VARIABLE wd 256 ALLOT
 
: setwd ( uaddr)
COUNT 1+ SWAP 1- SWAP wd SWAP CMOVE ;
 
: _wd
$" /rd/1/" setwd ; _wd
 
: "/ [CHAR] / ;
 
: strcat ( uaddr1 uaddr2 -- uaddr1+uaddr2)
>R DUP COUNT ( ua1 a1 c1)
>R R@ ( ua1 a1 c1)
+ OVER R> R@ SWAP >R ( ua1 ea1 ua1 ua1)
C@ R> + ( ua1 ea1 ua1 u+u2 )
SWAP C! ( ua1 ea1 )
R> COUNT ( ua1 ea1 a2 c2)
>R
SWAP R> CMOVE ;
 
: add/ ( uaddr -- uaddr/)
DUP DUP COUNT SWAP DROP + C@ "/ = IF ELSE $" /" strcat THEN ;
 
: cut/ ( uaddr -- uaddr w/o slash)
COUNT OVER SWAP + 1- ( ua1 lasta1)
DUP C@ "/ = IF 1- THEN .S
BEGIN 2DUP < WHILE 4 . DUP C@ "/ = IF OVER - OVER 1- C! 1- LEAVE ELSE 1- THEN
REPEAT ;
 
: t $" cat" $" dog" strcat COUNT TYPE ;
 
: makepath ( path normalizer: uaddr1 uaddr2 -- uaddr )
DUP 1+ C@ [CHAR] / = IF SWAP DROP ELSE DUP strcat THEN
add/ ;
 
 
: pwd ( print working directory: -- )
CR wd COUNT TYPE ;
 
: cd ( change directory)
wd BL WORD makepath setwd ;
/programs/develop/SPForth/meforth_samples/autorun2.f
0,0 → 1,15
: >asciiz + 0 SWAP C! ;
: >path
finfo @ 20 + 0 finfo @ 8 + ! DUP >R SWAP DUP >R CMOVE R> R> SWAP >asciiz ;
: >param
OVER finfo @ 8 + ! >asciiz ;
: exec
16 finfo @ ! finfo @ 58 sys2 ." started, code=" . CR 5 sys2 DROP ;
S" /RD/1/GRSCREEN" >path 99 exec
S" /RD/1/@RB" >path 30 exec
S" /RD/1/@SS" >path 30 exec
S" /RD/1/@PANEL" >path 30 exec
S" /RD/1/SETUP" >path S" BOOT" >param 30 exec
S" /RD/1/ICON2" >path S" BOOT" >param 10 exec
S" /RD/1/board" >path 25 exec
BYE
/programs/develop/SPForth/meforth_samples/example.f
0,0 → 1,53
DECIMAL
S" /rd/1/menuet.f" INCLUDED
 
: not_emit
emit_proc DUP @ NOT SWAP ! ;
 
new_reg wnd_size
 
CREATE Music $3090 , \ $90 C, $30 C, 0 C,
 
: my_wnd
12 ax 1 bx sysv DROP $805080D0 DUP $02AABBCC 200 50 << 200 DUP << 0
sys6 2 bx sysv 2DROP
$10DDEEFF $" ˆŒ… Žƒ€ŒŒ›" COUNT 8 DUP sys_print
0 $"  ¦¬¨â¥ «î¡ãî ª« ¢¨èã" COUNT 8 30 sys_print
$6688DD 1 5 12 << 200 19 - 12 << 8 sys5 DROP ;
 
: 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
0 emit_proc !
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 ;
 
: new_me ( new main loop)
handlers msg_loop_console ;
/programs/develop/SPForth/meforth_samples/locals.f
0,0 → 1,34
( ˆ§  à ­®¢ :
‘⥪ ¤ ­­ëå ª ª ã­¨¢¥àá «ì­®¥ á।á⢮ ¤«ï ¯¥à¥¤ ç¨ ¯ à ¬¥â஢ ¨ १ã«ìâ â®¢
¬¥¦¤ã ä®àâ-á«®¢ ¬¨ ¨¬¥¥â ­¥®á¯®à¨¬ë¥ ¯à¥¨¬ãé¥á⢠. ‚¬¥á⥠á ⥬ ¢­ãâà¨
®¯à¥¤¥«¥­¨ï ®­ ¨á¯®«ì§ã¥âáï ¤«ï ¯à®¬¥¦ãâ®ç­ëå ¢ëç¨á«¥­¨© ¨ à §¬¥é¥­¨ï §­ ç¥­¨©,
ª®â®àë¥ ¢ ­¨å ãç áâ¢ãîâ. â® ¢ë§ë¢ ¥â ®¯à¥¤¥«¥­­ë¥ âà㤭®á⨠¤«ï ¤®áâ㯠 ª
â ª®¬ã «®ª «ì­®¬ã §­ ç¥­¨î, ¯®áª®«ìªã ¥£® ¯®«®¦¥­¨¥ ®â­®á¨â¥«ì­® ¢¥à設ë á⥪ 
¯®áâ®ï­­® ¬¥­ï¥âáï.
„«ï ã¯à®é¥­¨ï à ¡®âë ¦¥« â¥«ì­® § ªà¥¯¨âì §  «®ª «ì­ë¬ ®¡ê¥ªâ ¬¨ ¢­ãâà¨
®¯à¥¤¥«¥­¨ï ­¥ª®â®àë¥ ¯®áâ®ï­­ë¥ ¨¬¥­ , ç¥à¥§ ª®â®àë¥ ¨ ®áãé¥á⢫ïâì ¤®áâ㯠ª
­¨¬.
ˆ¬¥î騩áï ¢ ï§ëª¥ ¬¥å ­¨§¬ ®¯¨á ­¨ï ¯¥à¥¬¥­­ëå ¢ ¤ ­­®¬ á«ãç ¥ ­¥ ¯®¤å®¤¨â,
¯®áª®«ìªã ᮧ¤ ¥â £«®¡ «ì­ë¥ ¨¬¥­ , ⮣¤  ª ª âॡã¥âáï ¨¬¥­®¢ âì «®ª «ì­ë¥
®¡ê¥ªâë, ãç¨âë¢ ï ¯à¨ í⮬ ¢®§¬®¦­®áâì ४ãàᨢ­ëå ¢ë§®¢®¢. ®áâ ¢«¥­­ãî § ¤ çã
à¥è ¥â ¢ª«î祭¨¥ ¢ à ¡®âã ¤®¯®«­¨â¥«ì­®£® á⥪ , ®â«¨ç­®£® ®â á⥪  ¤ ­­ëå.
‹®ª «ì­ë¥ §­ ç¥­¨ï à §¬¥é îâáï ¢ í⮬ á⥪¥ ¯à¨ ¢å®¤¥ ¢ ®¯à¥¤¥«¥­¨¥ ¨ 㡨à îâáï
¨§ ­¥£® ¯à¨ ¢ë室¥.
  ¢á¥ ¢à¥¬ï ¨á¯®«­¥­¨ï ®¯à¥¤¥«¥­¨ï ¨å ¯®«®¦¥­¨¥ ®â­®á¨â¥«ì­® ¢¥à設ë á⥪ 
®áâ ¥âáï ¯®áâ®ï­­ë¬, íâ® ¯®§¢®«ï¥â ®à£ ­¨§®¢ âì ®ç¥­ì ¯à®á⮩ ¤®áâ㯠ª â ª¨¬
§­ ç¥­¨ï¬.
à®á⥩è ï ­ ¤áâனª  ­ ¤ ï§ëª®¬ ”®àâ, ª®â®à ï ¯®§¢®«ï¥â à ¡®â âì á «®ª «ì­ë¬¨
¯¥à¥¬¥­­ë¬¨, ¢ë£«ï¤¨â â ª:)
 
 
100 ALLOT HERE CONSTANT LP0 ( €—€‹Ž ‹ŽŠ.‘’…Š€)
VARIABLE LP ( ’…Š“™€Ÿ ‚…˜ˆ€ ‹ŽŠ€‹œŽƒŽ ‘’…Š€)
: INITLP ( ->) LP0 LP ! ; INITLP
: LOC ( N:‘—…’—ˆŠ->) 1+ CELLS LP @ OVER - DUP LP ! ! ;
: UNLOC ( ->) LP @ @ LP +! ;
: @@ ( N:‘Œ…™->) CREATE , DOES> ( PFA->A) @ CELLS LP @ + @ ;
: !! ( N:‘Œ…™->) CREATE , DOES> ( A,PFA->) @ CELLS LP @ + ! ;
 
1 @@ @1 2 @@ @2 3 @@ @3 4 @@ @4 5 @@ @5 ( ˆ ’.„.)
 
1 !! !1 2 !! !2 3 !! !3 4 !! !4 5 !! !5 ( ˆ ’.„.)
/programs/develop/SPForth/meforth_samples/menuet.f
0,0 → 1,27
\ S" /rd/1/1st.4th" INCLUDED
S" /rd/1/locals.f" INCLUDED
 
\ : sys_wnd ( border, header, workarea, y, x -- )
\ 1 12 sys2 DROP 0 sys6 2 12 sys2 2DROP ;
 
\ : thread ( stack, entry -- )
\ 1 51 sys4 DROP ;
 
: >regs
reg_struc ! ;
 
: new_reg
CREATE 6 CELLS ALLOT LAST @ NAME> 9 + >regs ;
 
: ax reg_struc @ ! ;
: bx reg_struc @ 1 CELLS + ! ;
: cx reg_struc @ 2 CELLS + ! ;
: dx reg_struc @ 3 CELLS + ! ;
: si reg_struc @ 4 CELLS + ! ;
: di reg_struc @ 5 CELLS + ! ;
 
: << ( x,y -- x<<16+y )
SWAP 16 LSHIFT + ;
 
: sys_print ( color, stra, u, x, y -- )
<< >R SWAP ROT R> 4 sys5 DROP ;
/programs/develop/SPForth/meforth_samples/picture.f
0,0 → 1,109
DECIMAL
S" /rd/1/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
0 $"  ¦¬¨â¥ «î¡ãî ª« ¢¨èã" COUNT 8 30 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
0 emit_proc !
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 $" /rd/1/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 ïàðàìåòð )
0 ?DO
POSTPONE THEN
LOOP
; IMMEDIATE
 
[THEN]
 
: SS2 ( N ---> S:ÑÓÌÌÀ ÊÂÀÄÐÀÒÎÂ ÎÒ 1 ÄÎ N)
0 SWAP ( 0,N S[0]=0 )
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" ;
 
/programs/develop/SPForth/meforth_samples/.
Property changes:
Added: tsvn:logminsize
+5
\ No newline at end of property