( SPRITE EDITOR ( в дальнейшем называемый "редактор" ) ( Обмен с блоками форта происходит через MARK-буфер, который начинается по адресу MARK=HERE+257 и заканчивается кодом #00 . Формат передачи данных через MARK-буфер: hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh , где hh -- текст HEX-числа. ) FORTH EMPTY C? FREE CD :/SYS LOAD MOUSE CD :/SYS LOAD Q_SPRITES CD : C VOCABULARY se se DEFINITIONS --> CREATE ED-SPR 32 ALLOT CREATE ED-BUF 80 ALLOT : MARK PAD 1+ ; : +MARK ( a # -- добавить в MARK # байтов с адреса a ) R! MARK 320 0 C-MATCH 1- MARK + R! SWAP CMOVE R> R> + 0! ; : >MARK ( "out": запихать в MARK спрайт ) MARK 0! HEX 32 0 DO ED-SPR I + @ >< S>D <# BL HOLD BL HOLD # # BL HOLD # # #> +MARK I 8 MOD 6 = IF HERE 36 BLANK HERE 36 +MARK THEN 2 +LOOP DECIMAL ; : MARK> ( "in": снять из MARK спрайт ) >POINTER @ MARK >POINTER ! HEX ED-SPR 32 0 DO BL WORD DUP COUNT + 0! NUMBER DROP OVER C! 1+ LOOP DROP DECIMAL >POINTER ! >MARK ; --> CODE PICTURE 3098 ALLOT ' PICTURE 0 FETCH SE ED-BUF ' SPRITE H ED-SPR ' sprite ' MOUSE D# ASSEMBLE DRV_N EQU STACK MOUSE EQU STACK sprite EQU STACK ED_SPR EQU STACK HERE EQU STACK SPRITE EQU STACK ED_BUF EQU STACK PUT_HL EQU 8 PUT_AA EQU #18 GET_AA EQU #20 GET_HL EQU #30 PROMPT EQU #5B8D prompt EQU -17 TOP EQU 5 LEFT EQU 6 D EQU 4*256 C_IN EQU D+1 C_OUT EQU D+C_IN C_AUT EQU 3*D+C_OUT C_CLR EQU D+25 C_INV EQU D+C_CLR C_FLP EQU D+C_INV C_ROT EQU D+C_FLP C_SCR EQU D+C_ROT BEG_ATR EQU #5800 A_GRID EQU TOP*32+LEFT+BEG_ATR C_ARR EQU 256*5+C_OUT+1 C_LT EQU C_ARR-1 C_RT EQU C_ARR+1 r EQU C_ARR'256 A_ARR EQU C_ARR/256*32+r+BEG_ATR C_UP EQU C_ARR-256 C_DN EQU C_ARR+256 FIN DEFW 0 BPROMP DEFB 0 l_cellON EQU #BE l_cellNO EQU #80 s_cursor DEFB #80,#C0,#E0,#F0,#C0,#A0,#20,#18 b_cursor DEFS 32 SPR_X EQU 8 SPR_Y EQU 63 NEW EQU b_cursor+2 NEWC EQU NEW NEWB EQU NEW+1 OLD EQU NEW+8 SINA EQU OLD+2 COSA EQU OLD+4 ; : $ [ ASSEMBLE LD HL,SINA CALL PUT_HL ; ] ; $ FORGET $ DUP CONSTANT SINA 2+ CONSTANT COSA ASSEMBLE tst_but \ К-ты в аттрибутах: HL -- кнопки, DE -- мыши; B=шир. кн. (выс.=2). Верхняя строчка кнопки четна.\ LD A,D AND #FE CP H RET NZ LD A,L \ Z=1 => попали в кнопку \ nx_col CP E RET Z INC A DJNZ nx_col RET tst_arr LD A,H CP D RET NZ LD A,L CP E RET transpose ; :: ( BC -- BC~ ) ( H. ABORT ) 256 /MOD >R R! 2* 15 - COSA @ * 15 R> R@ SWAP >R 2* - SINA @ * + 3000 + 400 / R> 2* 15 - SINA @ * R> 2* 15 - COSA @ * + 3000 + 400 / 8 SHIFT OR ; DROP ASSEMBLE icon LD A,(X) LD C,A LD A,(Y) LD B,A PUSH BC LD A,SPR_X LD (X),A LD A,SPR_Y LD (Y),A LD HL,ED_BUF RST PUT_HL LD HL,ED_SPR CALL SPRITE+1 POP BC LD A,C LD (X),A LD A,B LD (Y),A RET tst1 LD HL,ED_SPR LD D,0 LD E,B ADD HL,DE ADD HL,DE LD A,C AND 8 JR Z,$+3 INC HL LD A,C AND 7 INC A LD B,A RET tst2 CALL tst1 LD A,(HL) nx_bit SLA A DJNZ nx_bit LD B,E \CF=искомый бит\ RET grid CALL icon LD BC,0 loop_g CALL tst2 \CF=искомый бит\ LD A,l_cellON JR C,$+4 AND l_cellNO LD (L_CELL),A LD A,B ADD A,TOP LD DE,192 LD L,A LD H,D ADD HL,HL ADD HL,HL ADD HL,HL EX DE,HL OR A SBC HL,DE LD A,B EX AF,AF LD B,5 LD A,L SUB 2 nx_lin DEC A LD I,A LD DE,FIRST LD H,0 LD L,A ADD HL,HL ADD HL,DE LD E,(HL) INC HL LD D,(HL) LD A,C ADD A,LEFT ADD A,E LD E,A JR NC,$+3 INC D LD A,0 L_CELL EQU $-1 LD (DE),A LD A,I DJNZ nx_lin EX AF,AF LD B,A looping LD A,C INC A AND #F LD C,A JP NZ,loop_g INC B BIT 4,B JP Z,loop_g mouse_on XOR A LD (b_cursor+1),A RET mouse_off CALL ADR EXX LD DE,b_cursor EX DE,HL CALL UNSPR EX DE,HL EXX JP mouse_on ; : ALERT ( -- n1 n2 ) [ 1 12 ] 2LITERAL [ 3 32 ] 2LITERAL MARK B/BUF + [ 10 16 ] 2LITERAL PANEL DROP ; : HIDE-ALERT ( n1 n2 -- ) MARK B/BUF + PUT ; : DIG ( -- n ) TIB 10 ERASE TIB 5 EXPECT [ TIB 1- ] LITERAL NUMBER DROP ; ' HIDE-ALERT ' ALERT ASSEMBLE ALERT EQU STACK HID_ALERT EQU STACK ; --> : AUT ALERT 2 SPACES CURSOR? ." Sprite Editor Version 2.1" 1+ 2DUP SWAP CURSOR ." Written by Khachaturov V." 1+ SWAP CURSOR 6 SPACES [ ASSEMBLE RES 3,(IX+3) ; ] 4 INK 1 BRIGHT 1 FLASH ." Tel. 210-95-78" 0. BRIGHT FLASH 5 INK BEGIN MOUSE >R 2DROP R> UNTIL HIDE-ALERT 50 MS [ ASSEMBLE ender LD HL,(FIN) JP (HL) ; ] ; H 1-! : BEG MARK> [ ASSEMBLE gridend CALL grid CALL ender ; ] ; : END >MARK PAGE ( RDEPTH . DEPTH . ABORT ) 2DROP QUIT ; ASSEMBLE clear LD B,32 LD HL,ED_SPR XOR A LD (HL),A INC HL DJNZ $-2 JR gridend invert LD B,32 LD HL,ED_SPR st_cpl LD A,(HL) CPL LD (HL),A INC HL DJNZ st_cpl JR gridend rotate CALL ALERT INC (IX-3) LD A,6 ADD A,(IX-4) LD (IX-4),A LD A,(PROMPT) LD (BPROMP),A LD (IX+prompt),#FF ; :: ." Rotation angle : " DIG DUP SIN 50 / SWAP COS 50 / HERE 32 ERASE ; DROP HEX 0CD HERE 3 - C! DECIMAL ' * ' / ASSEMBLE DIV EQU STACK MUL EQU STACK SCALE EQU 10000/50 LD A,(BPROMP) LD (PROMPT),A RST GET_HL LD (COSA),HL RST GET_HL LD (SINA),HL LD BC,0 loop_r CALL tst2 \CF=искомый бит\ JP NC,toloop_r LD (OLD),BC LD A,C EX AF,AF LD A,B RST PUT_AA CALL transpose RST GET_AA LD B,A EX AF,AF LD C,A LD HL,(HERE) LD (tst1+1),HL CALL set LD HL,ED_SPR LD (tst1+1),HL LD BC,(OLD) toloop_r LD A,C INC A AND #F LD C,A JP NZ,loop_r INC B BIT 4,B JP Z,loop_r LD BC,32 LD DE,ED_SPR LD HL,(HERE) LDIR CALL HID_ALERT JP gridend set \HL=адр.искомого байта; B=7-#нужного бита\ CALL tst1 XOR A SCF sh_mask RRA DJNZ sh_mask XOR (HL) LD (HL),A RET flp_E LD B,8 SRL E RLA DJNZ flp_E+2 RET flp_ln \вывернуть DE, не портя B и HL\ LD A,B EX AF,AF CALL flp_E LD E,D LD D,A CALL flp_E LD E,A EX AF,AF LD B,A RET flip CALL expector AND 1 JR NZ,hrz LD HL,flp_ln LD (SCR_LIN),HL JR sideways hrz LD B,8 LD HL,ED_SPR LD DE,ED_SPR+30 loop_h CALL swab INC HL INC DE CALL swab INC HL DEC DE DEC DE DEC DE DJNZ loop_h RET swab LD C,(HL) LD A,(DE) LD (HL),A LD A,C LD (DE),A RET scr_lt_ln LD A,D RLCA RL E RL D RET scr_rt_ln LD A,E RRCA RR D RR E RET scroll CALL expector OR A JR NZ,scr_nlt LD HL,scr_lt_ln LD (SCR_LIN),HL sideways LD HL,ED_SPR LD B,16 scr_nx_ln LD E,(HL) INC HL LD D,(HL) DEC HL CALL 0 SCR_LIN EQU $-2 LD (HL),E INC HL LD (HL),D INC HL DJNZ scr_nx_ln RET scr_nlt DEC A JR NZ,scr_nup LD HL,(ED_SPR) PUSH HL LD BC,30 LD DE,ED_SPR LD HL,ED_SPR+2 LDIR POP HL LD (ED_SPR+30),HL RET scr_nup DEC A JR NZ,scr_dn LD HL,scr_rt_ln LD (SCR_LIN),HL JR sideways scr_dn LD HL,(ED_SPR+30) PUSH HL LD BC,30 LD DE,ED_SPR+31 LD HL,ED_SPR+29 LDDR POP HL LD (ED_SPR),HL RET expector LD A,#80 LD R,A LD HL,A_ARR OR (HL) LD (HL),A POP HL LD (ARR_VEC),HL JP gridend arr XOR A LD R,A LD HL,A_ARR LD A,(HL) AND #7F LD (HL),A JP gridend lt XOR A JR end_exp up LD A,1 JR end_exp rt LD A,2 JR end_exp dn LD A,3 end_exp CALL exec JP gridend exec JP 0 ARR_VEC EQU exec+1 ; --> ' AUT ' BEG ' END CODE STEP ASSEMBLE LD HL,b_cursor RST PUT_HL LD HL,s_cursor CALL sprite+1 CALL MOUSE RST GET_AA EX AF,AF OR A JP Z,no_but CALL mouse_off LD A,(X) SRL A SRL A SRL A LD E,A SUB LEFT LD C,A LD A,(Y) SUB 192 NEG SRL A SRL A SRL A LD D,A SUB TOP LD B,A AND #F CP B JP NZ,buttons LD A,C AND #F CP C JP NZ,buttons CALL set JP gridend buttons LD HL,C_OUT LD B,2 CALL tst_but JP Z,STACK LD HL,C_IN LD B,2 CALL tst_but JP Z,STACK LD HL,C_AUT LD B,2 CALL tst_but JP Z,STACK LD HL,C_CLR LD B,5 CALL tst_but JP Z,clear LD HL,C_INV LD B,5 CALL tst_but JP Z,invert LD HL,C_FLP LD B,5 CALL tst_but JP Z,flip LD HL,C_ROT LD B,5 CALL tst_but JP Z,rotate LD HL,C_SCR LD B,5 CALL tst_but JP Z,scroll LD A,R JP P,no_but LD HL,C_LT CALL tst_arr JP Z,lt LD HL,C_UP CALL tst_arr JP Z,up LD HL,C_RT CALL tst_arr JP Z,rt LD HL,C_DN CALL tst_arr JP Z,dn LD HL,C_ARR CALL tst_arr JP Z,arr no_but CALL sc LD C,A LD A,(X) ADD A,C LD (X),A CALL sc LD B,A LD A,(Y) ADD A,B LD (Y),A RET sc RST GET_AA EX AF,AF LD E,A LD A,(DRV_N) CP 2 LD A,E RET NC ADD A,A RET ; --> FORTH DEFINITIONS : SE -- [ se ] 0. PAPER INK 0 BORDER PAGE PICTURE [ ASSEMBLE CALL mouse_off CALL grid XOR A LD R,A ; 96 128 ] 5 INK 2LITERAL X ! Y ! BEGIN STEP X @ 8 - 240 MOD 8 + X ! Y @ 8 - 160 MOD 8 + Y ! AGAIN ; CODE $$$ ASSEMBLE LD HL,no_but LD (FIN),HL RET ; $$$ FORGET $$$ FORTH \S 00 00 00 00 03 C0 0C 30 10 08 16 68 26 64 20 04 20 04 20 04 12 48 11 88 0C 30 03 C0 00 00 00 00