C? FREE CD SYS LOAD Q_SPRITES CD : C 32 360 9 / * CONSTANT O-TAB-SIZE CREATE O-TAB O-TAB-SIZE ALLOT CREATE O-BUF HEX 50 ALLOT : 8C: ( a -- a+8 ) HEX 8 0 DO BL WORD DUP COUNT + 0! NUMBER DROP OVER C! 1+ LOOP DECIMAL ; : 32C: ( a -- a+32 ) HEX 20 0 DO BL WORD DUP COUNT + 0! NUMBER DROP OVER C! 1+ LOOP DECIMAL ; CREATE omega 8 ALLOT omega 8C: 00 44 82 82 92 6C 00 00 DROP : 'OMEGA 360 MOD 9 / 32 * O-TAB + ; CR .( Базовые спрайты: ) O-TAB --> 45GEN 270GEN FORGET 45GEN .( ***************) 13 EMIT .( ++++) 4 +BLOCK 14 +BLOCK THRU .( 0 ) 32C: 00 00 00 00 03 E0 06 30 0C 18 18 0C 18 0C 18 0C 18 0C 0C 18 07 70 01 40 05 50 07 70 00 00 00 00 .( 9 ) 32C: 00 00 00 00 03 C0 06 60 0C 30 08 18 18 18 18 18 18 18 0C 30 07 60 01 40 01 50 05 70 06 00 00 00 .( 18 ) 32C: 00 00 00 00 03 C0 06 60 0C 30 08 18 18 18 18 18 18 18 0C 30 07 60 01 40 01 50 05 70 06 00 00 00 --> .( 27 ) 32C: 00 00 00 00 03 E0 04 30 08 18 18 0C 18 0C 18 0C 18 18 0C 30 07 A0 00 A0 00 54 01 58 01 80 00 00 .( 36 ) 32C: 00 00 00 00 03 E0 04 30 08 18 18 0C 18 0C 18 0C 18 18 0C 30 07 A0 00 A0 00 54 01 58 01 80 00 00 .( 45 ) 32C: 00 00 00 00 03 E0 04 70 08 38 10 18 10 08 10 08 18 10 1C 0A 0E 66 03 90 00 08 00 30 00 00 00 00 .( OK ) CR DROP --> : 45GEN ." Отражения: " 9 36 DO 16 0 DO ( Y ) 16 0 DO ( X ) K 'OMEGA J 2* + @ >< [ HEX ] 8000 [ DECIMAL ] I NEGATE SHIFT AND IF 90 K - 'OMEGA I 2* + DUP @ >< [ HEX ] 8000 [ DECIMAL ] J NEGATE SHIFT OR >< SWAP ! THEN LOOP LOOP 90 I - . -9 +LOOP ." OK" CR ; : 90GEN ." Повороты: " 90 OVER + SWAP DO 8 -7 DO ( Y ) 8 -7 DO ( X ) K 'OMEGA J 7 + 2* + @ >< 1 I 8 + SHIFT AND IF K 90 + 'OMEGA I 7 + 2* + DUP @ >< 1 8 J - SHIFT OR >< SWAP ! THEN LOOP LOOP I 90 + . 9 +LOOP ." OK" CR ; : 270GEN 270 0 DO I 90GEN 90 +LOOP ; .( +) VARIABLE omega# 10 omega# ! VARIABLE COUNT VARIABLE FREQ 10 FREQ ! DOER sync 50 CONSTANT MAX# VARIABLE end 128 CONSTANT X0 96 CONSTANT Y0 38 CONSTANT omega-size \ 0 DY 2 DX 4 Y 5 X 6 BUF CREATE omega-ring MAX# omega-size * ALLOT 0 , 0 , : >end< R! end ! R@ 0! R> 2+ 0! ; : omega-init omega-ring omega# @ DO' DUP R! 0! R@ 2+ 0! Y0 R@ 4 + C! X0 R> 5 + TUCK C! 1+ 32 ERASE omega-size + LOOP' >end< ; : 'free omega-ring BEGIN DUP 2@ OR ( 0 <> ) WHILE omega-size + REPEAT ; CREATE delta 1 , 1 , 0 , 1 , -1 , 1 , -1 , 0 , -1 , -1 , 0 , -1 , 1 , -1 , 1 , 0 , VARIABLE PDIR : get-delta ( -- dx dy ) PDIR @ 1- ( 8 MOD ) 7 AND DUP PDIR ! 2 SHIFT delta + 2@ ; .( +) : omega-launch 'free R! end @ = IF R-EXIT ELSE get-delta R@ ! R@ 2+ ! Y0 R@ 4 + C! X0 R> 5 + C! THEN ; : check ( a -- ) X @ DUP 8 < SWAP 247 > OR Y @ DUP 8 < SWAP 183 > OR OR IF DUP 0! 2+ 0! X 0! 8 Y ! ELSE DROP THEN ; : omega-step Y @ X @ omega-ring BEGIN R! end @ <> WHILE R@ 2@ OR IF R@ @ R@ 4 + C@ + DUP Y ! R@ 4 + C! R@ 2+ @ R@ 5 + C@ + DUP X ! R@ 5 + C! R@ check R@ 6 + omega sprite THEN R> omega-size + REPEAT RDROP X ! Y ! ; .( +) : ATTR-MAP 68 [ 11 31 ATTRIBUTE ] LITERAL R! C! 66 R@ 1+ C! 69 R@ 32 + C! 70 R> 33 + C! 0 [ 23 1 ATTRIBUTE ] LITERAL C! ; VARIABLE mode : OMEGA-ROT 0 >R BEGIN COUNT @ DUP 1+ FREQ @ MOD COUNT ! 0= IF mode @ DO' omega-launch LOOP' THEN O-BUF O-TAB R> 32 + O-TAB-SIZE MOD R! + SPRITE omega-step sync KEY? UNTIL R-EXIT ; : 2D 0 PAPER 5 INK 0 BORDER PAGE O-BUF 80 ERASE omega-init ATTR-MAP X0 8 - X ! Y0 8 + Y ! COUNT 0! PDIR 0! OMEGA-ROT 0 BORDER 0 BRIGHT 5 INK 0 PAPER PAGE ; .( +) C? FREE CD :/TOYS/WORDS LOAD MENU CD : C 2 EMIT .( +) 1 EMIT : .SELECTOR ASCII < EMIT 3 .R ASCII > EMIT ; 50 108 SW: SW1 83 108 SW: SW2 125 108 SW: SW3 157 108 SW: SW4 192 108 SW: SW5 DOER OMEGATRON CREATE picture 6000 ALLOT .( +) : NUL 30 DO' 4 I' TONE LOOP' ; : NUL! MAKE OMEGATRON NUL ; : ?? @ 3 .R ; : -# omega# @ 1 > IF omega# 1-! 5 37 CURSOR omega# ?? THEN ; : +# omega# @ MAX# < IF omega# 1+! 5 37 CURSOR omega# ?? THEN ; : -F FREQ @ 8 > IF FREQ 1-! 6 37 CURSOR FREQ ?? THEN ; : +F FREQ @ 999 < IF FREQ 1+! 6 37 CURSOR FREQ ?? THEN ; : off 0 SW1 NUL PAGE ABORT ; : cont 1 SW2 1 mode ! ; : pulse 0 SW2 8 mode ! ; : +sync 1 SW3 MAKE sync 0 SYNC ; : -sync 0 SW3 UNDO sync ; : 3D 1 SW4 NUL! ; : 2D 0 SW4 MAKE OMEGATRON 2D ; : start 1 SW5 3 8 18 56 picture GET DROP OMEGATRON 3 8 picture PUT 0 SW5 ; .( +) 36 36 5 ' -# POS: '-#' 40 40 5 ' +# POS: '+#' 36 36 6 ' -F POS: '-F' 40 40 6 ' +F POS: '+F' 16 12 13 ' off POS: 'off' 24 20 9 ' cont POS: 'cont' 24 20 13 ' pulse POS: 'pulse' 36 29 9 ' +sync POS: '+sync' 36 29 13 ' -sync POS: '-sync' 43 38 9 ' 3D POS: '3D' 43 38 13 ' 2D POS: '2D' 51 47 9 ' start POS: 'start' .( +) \ CUR LT UP RT DN LINK: '-#' '+#' '-sync' '+#' '-F' LINK: '+#' '-#' '2D' '-#' '+F' LINK: '-F' '+F' '-#' '+F' 'start' LINK: '+F' '-F' '+#' '-F' 'start' LINK: 'cont' 'start' '-F' '+sync' 'pulse' LINK: '+sync' 'cont' '-F' '3D' '-sync' LINK: '3D' '+sync' '-F' 'start' '2D' LINK: 'start' '3D' '-F' 'off' 'off' LINK: 'off' 'start' '-F' 'pulse' '-#' LINK: 'pulse' 'off' 'cont' '-sync' '-#' LINK: '-sync' 'pulse' '+sync' '2D' '+#' LINK: '2D' '-sync' '3D' 'start' '+#' .( +) : selector 0 'start' BEGIN KEY# CASE 5 OF -1 CUR^ ENDOF 13 OF -1 CUR^ ENDOF 90 OF 1 CUR^ ENDOF 91 OF 2 CUR^ ENDOF 92 OF 3 CUR^ ENDOF 93 OF 4 CUR^ ENDOF ENDCASE 5 30 TONE 100 MS AGAIN ; .( +) : PICTURE PAGE 6 1 12 44 0 4 10 PANEL 3DROP 5 18 CURSOR ." O m e g a t r o n" 5 36 CURSOR omega# @ .SELECTOR 6 18 CURSOR ." P e r i o d" 6 36 CURSOR FREQ @ .SELECTOR 9 11 CURSOR ." on cont sync on 3D start" 13 11 CURSOR ." off pulse sync off 2D stop" ; : [0] BODY [COMPILE] LITERAL COMPILE 0! ; IMMEDIATE : OMEGA ( n X Y ) Y ! X ! O-BUF DUP 0! SWAP 'OMEGA SPRITE ; : O PICTURE [0] SW1 [0] SW2 [0] SW3 [0] SW4 [0] SW5 1 SW1 cont +sync 2D 0 SW5 -45 35 76 OMEGA -135 35 162 OMEGA 0 120 76 OMEGA 45 205 76 OMEGA 135 205 162 OMEGA selector ; .( +)