/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 |