FORTH EMPTY HERE ASSEMBLE CLEAR FIRST DEFS 192*2 ; : & ( A -- ) 24 0 DO I 0 [ 1997 ] CALL ( 'SCREEN ) DROP 8 0 DO 2DUP SWAP ! 256 + SWAP 2+ SWAP LOOP DROP LOOP DROP ; ( Строка 0 сверху ) & FORGET & HERE ASSEMBLE XnxCopyrt DEFS 2031 \*!*\ ; 2031 FETCH Xonix HERE ASSEMBLE XnxBackgr DEFS 660 \*!*\ ; 660 FETCH Xonix$ ' / ' * ' . ' KEY? ' KEY# ' -- ' .R ' CHOOSE ' PAGE ' */ ASSEMBLE MULDIV EQU STACK PAGE EQU STACK CHOOSE EQU STACK PTRT EQU STACK SME_OFF EQU STACK KEYNUM EQU STACK KEYIF EQU STACK PT EQU STACK MUL EQU STACK DIV EQU STACK PUT_HL EQU 8 PUT_AA EQU #18 GET_AA EQU #20 GET_HL EQU #30 P_DEHL EQU #28 PRINT EQU #10 sh_bc EQU #2B49 \*!*\ CURSOR EQU #5B9A ATTR EQU #5BA0 FLD_SIZE EQU 44*64 fld_size EQU 40*60 FLD DEFS FLD_SIZE DEFW 0 T0 DEFS fld_size OBJ EQU $ DEFB 0,0,0,0 NIL EQU %000 \пустота\ DEFB #FF,#AA,#FF,#AA WEB EQU %001 \паутина\ DEFB #66,#FF,#FF,#66 THR EQU %010 \ нить \ DEFB #99,#66,#66,#99 SPI EQU %011 \ паук \ DEFB #66,#99,#99,#66 FLY EQU %100 \ муха \ DEFB #00,#66,#66,#00 POL EQU %101 \таракан\ MRK EQU %111 \ метка \ \ Объект MRK -- метка, не предн. для вывода; исп. при заливке от каждой мухи. Закрашивать можно пустоту, нить и мух, т.е. объекты со сброшенным битом #0.\ PERIOD EQU 1024 \период появления нового полисмена\ MAX_FLY EQU 10 MAX_POL EQU 10 FLY_RING DEFS MAX_FLY*4 POL_RING DEFS MAX_POL*4 \Элемент кольца: DEFB Col DEFB Lin DEFB dC DEFB dL\ XY \ BC= к-ты на поле --> HL= &XY A= 0 \ XOR A LD H,A LD L,B ADD HL,HL ADD HL,HL LD (YY),HL ADD HL,HL ADD HL,HL ADD HL,HL ADD HL,HL LD B,A ADD HL,BC LD BC,FLD ADD HL,BC RET sput \HL= &XY E= #спр.\ PUSH HL EXX POP HL LD BC,0-FLD ADD HL,BC LD A,#3F AND L LD C,A PUSH BC PUSH BC LD A,H SLA L ADC A,A SLA L ADC A,A LD L,A XOR A LD H,A ADD HL,HL ADD HL,HL LD (YY),HL EXX JP reput eraput \ BC= к-ты на поле, E= #спр. \ PUSH BC PUSH BC \# в массив\ CALL XY reput LD (HL),E \# |-> адр. спр.\ LD H,A LD A,E LD (EE),A ADD A,A ADD A,A LD L,A LD DE,OBJ ADD HL,DE EX DE,HL POP BC XOR A LD A,C RRA EXX LD D,0 LD E,A LD BC,2 EXX LD A,#F JR C,$+3 CPL \ A= маска, DE= адр. спр.\ LD (mask),A CPL LD (MASK),A LD HL,0 YY EQU $-2 LD BC,FIRST ADD HL,HL ADD HL,BC LD (ind),HL LD B,4 \B=счет. DE=а.спр HL=а.экр.б.\ lin4 EXX \new = (scr & (!mask)) | (spr & mask)) \ LD HL,(0) ind EQU $-2 ADD HL,DE PUSH HL EXX POP HL LD A,(HL) AND 0 MASK EQU $-1 LD C,A LD A,(DE) AND 0 mask EQU $-1 OR C INC DE LD (HL),A EXX LD HL,(ind) ADD HL,BC LD (ind),HL EXX DJNZ lin4 POP BC LD E,0 EE EQU $-1 RET pr_lives CALL sSP LD A,0 LIVES EQU $-1 LD HL,#170C LD (CURSOR),HL ADD A,"0" JP PRINT weblin2 CALL weblin INC B weblin LD C,0 CALL eraput INC C BIT 6,C RET NZ JP weblin+2 cold CALL SME_OFF LD A,1 LD (NUMFLI),A EXX LD (BSP),HL SET 3,(IX+3) \no attr change\ IN A,(6) AND #F8 OUT (#FE),A CALL PAGE LD A,5 LD (ATTR),A LD (LIVES),A CALL XnxCopyrt CALL sSP CALL KEYNUM RST GET_AA CALL PAGE XOR A LD (OLDBONUS),A LD DE,(SCORE) LD HL,(HI) SBC HL,DE JR NC,same LD (HI),DE same LD H,A LD L,A LD (SCORE),HL level CALL XnxBackgr CALL pr_lives CALL sSP LD HL,#160C LD (CURSOR),HL LD HL,0 SCORE EQU $-2 RST PUT_HL CALL PT LD HL,#1637 LD (CURSOR),HL LD HL,0 HI EQU $-2 RST PUT_HL CALL PT LD A,0 NUMFLI EQU $-1 CP MAX_FLY JP Z,sSP INC A LD (NUMFLI),A LD BC,FLD_SIZE-1 LD E,0 LD HL,FLD CALL sh_bc+1 LD B,0 LD E,WEB CALL weblin2 INC B nx_lin LD C,0 CALL eraput INC C CALL eraput LD C,62 CALL eraput INC C CALL eraput INC B LD A,B CP 42 JP NZ,nx_lin LD (POL_RING+1),A CALL weblin2 LD BC,#0020 LD E,SPI CALL eraput LD H,B LD L,B LD (TIME),HL LD A,1 LD (NUMPOL),A LD A,C LD (POL_RING),A CALL XY LD (POS),HL LD HL,FLD_SIZE-fld_size LD (AREA),HL CALL sSP LD A,(NUMFLI) LD B,A LD HL,FLY_RING sFLYi PUSH BC PUSH HL LD A,60 EX AF,AF XOR A RST PUT_AA CALL CHOOSE RST GET_AA EX AF,AF POP HL ADD A,2 LD (HL),A INC HL PUSH HL LD A,40 EX AF,AF XOR A RST PUT_AA CALL CHOOSE RST GET_AA EX AF,AF POP HL ADD A,2 LD (HL),A INC HL CALL RNDELTA LD (HL),A INC HL CALL RNDELTA LD (HL),A INC HL POP BC DJNZ sFLYi LD HL,POL_RING+2 CALL RNDELTA LD (HL),A INC HL CALL RNDELTA LD (HL),A LD BC,#2A20 LD E,POL CALL eraput steady CALL paint XOR A LD (PULLING),A LD H,A LD L,A LD (DELTA),HL LD HL,T0 LD (TP),HL LD BC,#0020 CALL XY LD (POS),HL LD A,WEB LD (OLDCELL),A go CALL gJDIR CTRL EQU $-2 LD HL,(DELTA) LD A,H OR L LD HL,(POS) JP Z,do_it LD E,0 OLDCELL EQU $-1 CALL sput LD DE,0 POS EQU $-2 LD HL,(DELTA) ADD HL,DE \DE=OLD HL=NEW\ LD A,0 PULLING EQU $-1 OR A CALL NZ,logweb LD BC,0 DELTA EQU $-2 LD A,B OR C LD A,(HL) JR Z,do_it LD (OLDCELL),A CP THR JP Z,die CP POL JP Z,die CP FLY JP Z,die OR A JR Z,free_c LD A,(PULLING) OR A JP Z,do_it PUSH HL CALL thr2web POP HL EXX LD HL,0 PERCENT EQU $-2 LD A,L EXX CP 75 JR C,do_it CALL sSP LD HL,(PERCENT) CALL PUT_HL LD A,(NUMFLI) DEC A EX AF,AF XOR A RST PUT_AA CALL MUL LD A,(NUMPOL) SUB MAX_POL NEG INC A EX AF,AF XOR A RST PUT_AA CALL MUL RST GET_HL LD DE,(SCORE) ADD HL,DE LD (SCORE),HL RST PUT_HL LD HL,600 RST PUT_HL CALL DIV RST GET_AA LD A,0 OLDBONUS EQU $-1 LD B,A EX AF,AF LD C,A SUB B JP Z,level LD D,A LD A,C LD (OLDBONUS),A LD A,(LIVES) ADD A,D LD (LIVES),A JP level free_c CPL LD (PULLING),A LD A,THR LD (OLDCELL),A do_it LD (POS),HL LD E,SPI CALL sput LD B,100 DJNZ $ LD A,(NUMFLI) LD HL,FLY_RING nxFLYmov LD (FLICOU),A LD (CF),HL LD (CF1),HL LD C,(HL) INC HL LD B,(HL) INC HL \B=L C=C (HL)=dC\ LD A,C ADD A,(HL) LD (C1),A INC HL LD A,B ADD A,(HL) LD (L1),A LD BC,(C1) CALL XY LD A,(HL) OR A JR NZ,came LD BC,(0) CF EQU $-2 LD E,NIL CALL eraput LD BC,0 L1 EQU $-1 C1 EQU $-2 LD (0),BC CF1 EQU $-2 LD E,FLY CALL eraput JP tonxFM tear LD HL,(POS) LD E,NIL CALL sput JP die came CP THR JP Z,tear CP SPI JP NZ,came1 LD A,(PULLING) OR A JR NZ,tear came1 LD HL,(CF) EX DE,HL LD HL,2 ADD HL,DE EX DE,HL LD C,(HL) LD A,(L1) LD B,A CALL XY LD A,-1 LD R,A LD A,(HL) OR A JR NZ,vert LD R,A LD A,(DE) NEG LD (DE),A vert INC DE LD HL,(CF) INC HL LD B,(HL) LD A,(C1) LD C,A CALL XY LD A,(HL) OR A JR NZ,chkang LD R,A LD A,(DE) NEG LD (DE),A chkang LD A,R JP P,tonxFM LD A,(DE) NEG LD (DE),A DEC DE LD A,(DE) NEG LD (DE),A tonxFM LD A,0 FLICOU EQU $-1 DEC A LD HL,(CF) LD DE,4 ADD HL,DE JP NZ,nxFLYmov LD A,(NUMPOL) LD HL,POL_RING nxPOLmov LD (POLCOU),A LD (Cp),HL LD (CP1),HL LD C,(HL) INC HL LD B,(HL) INC HL \B=L C=C (HL)=dC\ LD A,C ADD A,(HL) CP -1 JR Z,cd CP 64 JR Z,cd LD (c1),A INC HL LD A,B ADD A,(HL) CP -1 JR Z,cd CP 44 JR Z,cd LD (l1),A LD BC,(c1) CALL XY LD A,(HL) CP WEB JR NZ,camel LD BC,(0) Cp EQU $-2 LD E,WEB CALL eraput LD BC,0 c1 EQU $-2 l1 EQU c1+1 LD (0),BC CP1 EQU $-2 LD E,POL CALL eraput JP tonxPM cd LD A,(HL) NEG LD (HL),A JP tonxPM camel CP SPI JP NZ,camel1 LD A,(PULLING) OR A JR NZ,camel1 LD HL,(Cp) INC HL INC HL LD A,(HL) NEG LD (HL),A INC HL LD A,(HL) NEG LD (HL),A LD HL,(POS) LD E,WEB CALL sput JP die camel1 LD HL,(Cp) EX DE,HL LD HL,2 ADD HL,DE EX DE,HL LD C,(HL) LD A,(l1) LD B,A CALL XY LD A,-1 LD R,A LD A,(HL) CP WEB JR NZ,verT LD R,A LD A,(DE) NEG LD (DE),A verT INC DE LD HL,(Cp) INC HL LD B,(HL) LD A,(c1) LD C,A CALL XY LD A,(HL) CP WEB JR NZ,chkanG LD R,A LD A,(DE) NEG LD (DE),A chkanG LD A,R JP P,tonxPM LD A,(DE) NEG LD (DE),A DEC DE LD A,(DE) NEG LD (DE),A tonxPM LD A,0 POLCOU EQU $-1 DEC A LD HL,(Cp) LD DE,4 ADD HL,DE JP NZ,nxPOLmov LD HL,0 TIME EQU $-2 INC HL LD (TIME),HL LD DE,PERIOD OR A SBC HL,DE JR NZ,goer LD (TIME),HL LD A,(NUMPOL) CP MAX_POL JR Z,goer LD DE,POL_RING LD L,A ADD HL,HL ADD HL,HL ADD HL,DE INC A LD (NUMPOL),A LD (HL),32 INC HL CALL RNDELTA INC A RRCA ADD A,42 LD (HL),A INC HL CALL RNDELTA LD (HL),A INC HL CALL RNDELTA LD (HL),A goer JP go sSP LD HL,0 BSP EQU $-2 EXX RET NUMPOL DEFB 0 RNDELTA LD A,R AND #40 RLCA RLCA RLCA DEC A RET logweb \HL=NEW DE=OLD\ LD BC,0 TP EQU $-2 LD A,E LD (BC),A INC BC LD A,D LD (BC),A INC BC LD (TP),BC RET die LD HL,(TP) DEC HL LD D,(HL) DEC HL LD E,(HL) LD A,D OR E JP NZ,erase CALL sSP LD A,(LIVES) DEC A JP Z,cold LD (LIVES),A CALL pr_lives JP steady erase LD (TP),HL EX DE,HL LD E,NIL CALL sput JP die thr2web LD HL,(TP) DEC HL LD D,(HL) DEC HL LD E,(HL) LD A,D OR E JP Z,paint LD (TP),HL EX DE,HL LD E,WEB CALL sput LD HL,(AREA) INC HL LD (AREA),HL JP thr2web gJDIR CALL sSP CALL KEYIF RST GET_AA LD HL,500 waiter DEC HL LD A,H OR L JR NZ,waiter IN A,(#FF) AND #1F JR Z,no_change JR new_delta gKDIR CALL sSP CALL KEYIF RST GET_AA OR A JR NZ,scan no_change LD HL,(DELTA) JP st_kdir scan CALL KEYNUM RST GET_AA EX AF,AF new_delta LD HL,0 LD DE,64 CP #2 K_LT EQU $-1 JP NZ,nolt DEC HL JP st_kdir nolt CP #8 K_UP EQU $-1 JP NZ,noup SBC HL,DE JP st_kdir noup CP #1 K_RT EQU $-1 JR NZ,nort INC L JP st_kdir nort CP #4 K_DN EQU $-1 JR NZ,st_kdir ADD HL,DE st_kdir EX DE,HL LD HL,(POS) LD BC,0-FLD ADD HL,BC LD A,L AND 63 LD C,A LD A,H SLA L RLA SLA L RLA LD B,A \DE=DELTA BC=COORDS\ LD HL,0 LD A,D OR E JR Z,fence LD A,D XOR E OR A JP NZ,nonlt LD L,-1 JP fence nonlt CP 1 JP NZ,nonrt LD L,A JP fence nonrt CP #40 JR NZ,nondn LD H,1 JP fence nondn LD H,-1 fence LD A,C OR A JP NZ,tstrt BIT 7,L JR NZ,stop tstrt CP 63 JP NZ,tstup DEC L JR Z,stop tstup LD A,B OR A JP NZ,tstdn BIT 7,H JR NZ,stop tstdn CP 43 JP NZ,store DEC H JP NZ,store stop LD DE,0 store LD (DELTA),DE RET tort \HL=&XY --> HL=&XrY Find 1st pt like NOT STATUS\ LD D,0 STATUS EQU $-1 tort_l LD A,(HL) AND 1 CP D RET NZ INC HL JP tort_l tolt \HL=&XY --> HL=&XlY Find 1st pt like NOT STATUS\ LD A,(STATUS) LD D,A tolt_l LD A,(HL) AND 1 CP D RET NZ DEC HL JP tolt_l STOP EQU -1 paint XOR A LD H,A LD L,A LD (DELTA),HL LD (PULLING),A ADD HL,SP LD (BRP),HL LD HL,(BSP) LD SP,HL LD HL,FLY_RING LD A,(NUMFLI) LD B,A LD DE,3 nxflood LD A,(HL) INC HL EX AF,AF LD A,(HL) ADD HL,DE EXX LD B,A EX AF,AF LD C,A CALL XY LD (STATUS),A CALL tort DEC HL LD DE,STOP PUSH DE beg_p LD A,H INC A JP Z,already LD (CRP),HL LD DE,#0701 \D=MRK E=1\ LD A,(HL) AND E LD C,0 JR Z,includ step_lt DEC HL includ LD A,(HL) AND E JR NZ,st_clp LD (HL),D LD A,C OUT (#FE),A XOR 0 FX EQU $-1 LD C,A JP step_lt st_clp XOR A OUT (#FE),A LD (CLP),HL \Найти все затрав. точки спр. от CLP и полож. на ст.\ LD HL,0 CRP EQU $-2 LD DE,64 ADD HL,DE LD A,(HL) AND 1 JR NZ,nonemp LD (STATUS),A CALL tort nonemp LD A,1 LD (STATUS),A CALL tolt XOR A beg_chk LD (STATUS),A EX DE,HL LD HL,0 CLP EQU $-2 LD BC,64 ADD HL,BC OR A SBC HL,DE EX DE,HL JR NC,chk_dn OR A \STAT\ JR NZ,nodub PUSH HL nodub CALL tolt LD A,(STATUS) XOR 1 JP beg_chk chk_dn LD HL,(CRP) LD DE,-64 ADD HL,DE LD A,(HL) AND 1 JR NZ,nonemP LD (STATUS),A CALL tort nonemP LD A,1 LD (STATUS),A CALL tolt XOR A beg_chK LD (STATUS),A EX DE,HL LD HL,(CLP) LD BC,-64 ADD HL,BC OR A SBC HL,DE EX DE,HL JP NC,beg_pp OR A JR NZ,noduB PUSH HL noduB CALL tolt LD A,(STATUS) XOR 1 JP beg_chK beg_pp POP HL JP beg_p celweb LD E,WEB CALL eraput LD HL,0 AREA EQU $-2 INC HL LD (AREA),HL JP incER already EXX DEC B JP NZ,nxflood LD SP,0 BRP EQU $-2 LD BC,#0202 nxER PUSH BC CALL XY POP BC LD A,(HL) OR A JR Z,celweb CP MRK JR NZ,incER LD (HL),0 incER INC C LD A,C CP 62 JP NZ,nxER LD C,2 INC B LD A,B CP 42 JP NZ,nxER LD HL,FLY_RING LD A,(NUMFLI) nx_rest EX AF,AF LD C,(HL) INC HL LD B,(HL) LD DE,3 ADD HL,DE PUSH HL LD E,4 CALL eraput POP HL EX AF,AF DEC A JP NZ,nx_rest CALL sSP LD HL,(AREA) LD DE,100 RST P_DEHL LD HL,FLD_SIZE RST PUT_HL CALL MULDIV LD HL,#1739 LD (CURSOR),HL RST GET_HL LD (PERCENT),HL RST PUT_HL LD HL,3 RST PUT_HL JP PTRT ; : P CR ." Press a new extend key for " ; HEX : Q [ 10 50 ] 2LITERAL TONE ; : Y/N ( -- NOT? ) ." (Y/N)? " 0 BEGIN DROP KEY# DUP 011 = OVER 002 = OR UNTIL 002 = Q ; DECIMAL : G KEY# Q ; : M PAGE ." Select controls for XONIX v 2.0" CR ." written by Khachaturov Vassily" CR ." Tel. 210-95-78" CR CR ." Do you want to use KEMPSTON" Y/N ; --> : NO ." No." ; : YES ." Yes." ; : FX? CR ." Do you want the 'door-squeak' effects" Y/N IF NO 0 ELSE YES [ HEX ] 010 THEN CR [ DECIMAL ] ." Do you want border effects" Y/N IF NO 0 ELSE YES 5 THEN [ ASSEMBLE RST GET_HL RST GET_AA EX AF,AF OR L LD (FX),A ; ] ; : GG P ." LEFT" G P ." UP" G P ." RIGHT" G P ." DOWN" G ; : XONIX M IF NO GG [ ASSEMBLE LD HL,gKDIR LD (CTRL),HL RST GET_AA EX AF,AF LD (K_DN),A RST GET_AA EX AF,AF LD (K_RT),A RST GET_AA EX AF,AF LD (K_UP),A RST GET_AA EX AF,AF LD (K_LT),A ; ] CR ." Use any other extend key for STOP." ELSE YES THEN FX? CR ." Press a key to begin..." G DROP [ ASSEMBLE LD HL,0 LD (SCORE),HL JP cold ; ] ;