Rev 1935 | Rev 1960 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
DEVICE ZXSPECTRUM128 include "settings.asm" NTEXPGS=0 curpg=0x5b5c pgtmp=#04 ;tcos=#5B00 imer=#7F7F INTSTACK=imer imstackbegin=imer&0xff00 distbuf=#7C00 ;#300 ;ID,texx,dist page 0 ORG #6000;,0 begin jp init IF doublescr SETPG LD (curpg),A curscr=$+1 OR 0 LD BC,#7FFD OUT (C),A RET ENDIF INCLUDE "WCTRL.ASM" ;переменные рендера (обновляются в начале рендера) curXx curx DB #80 curX DB #0 curYy cury DB #80 curY DB #0 curxy DW 0 curyx DW 0 curYX DW 0 curangle DW tsin demobegin IF demoplay INCBIN "demorec*" ELSE DB %00111111 ;all keys released ENDIF align 256 tlogd2sca IF scale64 IF scale64 == 3 INCBIN "logd2sc3" ELSE INCBIN "logd2sc2" ENDIF ELSE INCBIN "logd2sc_" ENDIF tsqr2 INCBIN "sqr2int" tlogd INCBIN "logd" tcorrlogd INCBIN "corlogd_" ORG $-256 DUP 256 DB {$+(scrtopx*8)}&0xff EDUP IF lores ORG $-256 _=$ DUP 128 DB {_}&0xff _=_+2 EDUP DS 128 ENDIF tcos DS 256 tlogcos INCBIN "pluslcos" tda INCBIN "da" ORG $-256 DUP 256 DB 0xff&({$}+128) EDUP ORG $-256 DUP 256 DB 0xff&({$+(scrtopx*8)}) EDUP IF lores ORG $-256 _=$ DUP 128 DB {_}&0xff _=_+2 EDUP DS 128 ENDIF tctg INCBIN "plusctg" tsin INCBIN "sin" cursprites DS 256 DISPLAY "tables end=",$ tscalesw3 incbin "scalesw3" ;DS #8000-$ ds imstackbegin-$ ds imer-$ include "int.asm" ;DS ((IMER/256+1)<<8)-$ ;ds (IMER&0xff00)-$ ds 0x8000-$ ;ORG #8000 imvec DS 257,imer&0xff INCLUDE "zxloop.asm" INCLUDE "WSCAN10.asm" INCLUDE "WREND.asm" include "beeper.asm" include "beeper_sfxdata.asm" badmonstexture db 0xc0,0xff align 256 t1x db 255 dup 255 db (255*2/($&0xff)+1)/2 edup include "anims.asm" include "savestate.asm" DISPLAY "48K PROG END=",$ ORG distbuf include "recmap.asm" DS distbuf+#300-$ ;;;;; ORG scrbuf GO ;xor a ;out (0xfe),a DI LD HL,WAStcos LD DE,tcos PUSH DE LD BC,256 LDIR POP HL REtcos0 DUP 2;4 SRA (HL) EDUP INC L jr nz,REtcos0 ;IF music ; CALL #8000 ;init mus ;ENDIF LD HL,imvec LD DE,imvec+1 LD (HL),imer/256 LD B,E,C,L LD A,H LDIR LD I,A IM 2 EI HALT LD HL,-2 ADD HL,SP LD (clscrbufsp),HL LD (eorfillsp),HL ld hl,ZXLOOP push hl LD BC,#FBDF IN A,(C) LD (mouseoldx),A JP RECMAP ;->ZXLOOP display "ZXLOOP=",ZXLOOP WASMAP IF invmap;atmINCBIN "mapatm.E" ELSE INCBIN "map48.E" ENDIF szMAP=$-WASMAP WAStcos INCBIN "cos" init if mouse call initmouse endif ;prepare 48K block DI ;IY LD HL,#5800 LD DE,#5801 LD BC,767 LD (HL),L LDIR ;LD BC,#7FFD ;LD A,pgtmp|#10 ;OUT (C),A LD HL,waswalls;#C000 call copyscrcolumns ;LD DE,#4000 ;LD BC,#1800 ;LDIR ;LD BC,#7FFD ;LD A,#10 ;OUT (C),A LD DE,#C000+0x80;maxscale+1 LD HY,d;0xc0;#FE ;4 upper textures = #09A6 ;4 lower textures = #0AAC LD HL,#4000 CALL GETTEX CALL GETTEX CALL GETTEX CALL GETTEX push de LD HL,waswalls+0x800;#C000 call copyscrcolumns pop de LD HL,0x4000;#4800 CALL GETTEX CALL GETTEX CALL GETTEX CALL GETTEX push de LD HL,waswalls+0x1000;#C000 call copyscrcolumns pop de LD HL,0x4000;#5000 CALL GETTEXCALL GETTEX CALL GETTEX CALL GETTEX ;PUSH DE ;LD BC,#7FFD ;LD A,pgtmp|#10 ;OUT (C),A ;jr $ ;walls: de=d7e6 (e862 12 шт) ;LD HL,wasgoods;#DB00 ;call copyscrcolumns ;LD DE,#4000 ;LD BC,#1800 ;LDIR ;LD BC,#7FFD ;LD A,#10 ;OUT (C),A ;POP DE LD HL,#4808 CALL GETSPR LD HL,#4818 CALL GETSPR LD HL,#5008 CALL GETSPR LD HL,#5018 CALL GETSPR ;jr $ ;walls: с оптимизацией de=e152 (e2b4 12 шт) (f158 12 шт+2 спрайта без оптимизации) ;jr $ ;пак 7: с оптимизацией de=ec70[ebdf] (f4c8 12 шт) ;jr $ ;пак 3: с оптимизацией de=e1e4[de70] ;jr $ ;пак 2: с оптимизацией de=f070[f6cd] ;jr $ ;пак 1: с оптимизацией de=efdf[ef76, без оптимизации f256] if 1 ;исправляем переполнения адресов текстур (адреса в ПЗУ заменяем на 0xc080, а для спрайтов на badmonstexture) ld h,0xc0 fixtexoverflow0 ld l,0x40 fixtexoverflow1 ld e,(hl) inc h ld d,(hl) bit 7,d jr nz,$+5 ;не в ПЗУ badaddrpatch=$+1 ld de,0xc080 ld (hl),d dec h ld (hl),e inc l jp p,fixtexoverflow1 inc h inc h ld de,badmonstexture ld a,h cp 0xc0+(2*12) jr c,$+6 ld (badaddrpatch),de cp 0xc0+(2*16) jr nz,fixtexoverflow0 endif ;составляем таблицу масштабирования ld hl,tscalesw3 ld c,0 ld b,64 initscales0 ld e,(hl) inc hl ld d,(hl) inc hl push hl ld l,c push bc ld b,d ld c,e ;adder 8.8 ;надо из 0040...0400 сделать 78..00 до начала(0x80 -08..-80) = 0x80 - adder*32 ;надо из 0040...0400 сделать 78..04 в начале (0x80 -08..-7c) = 0x80 - adder*31 ;... ;надо из 0040...0400 сделать 87..f4 (0x80 +07..+74) ;надо из 0040...0400 сделать 88..f8 в конце (0x80 +08..+78) dup 5 sla e rl d edup xor a sub e ld e,a ld a,0x80 sbc a,d ld d,a ;0x80 - adder*32 ld h,0xc0 ld (hl),0 ;зачем? при d виснет из-за спрайтов inc h initscales1 ex de,hl add hl,bc ex de,hl ld (hl),d ;Ys=(Y/32-1)*sc inc h jr nz,initscales1 ;dec h ;ld (hl),3 ;зачем? pop bc inc c pop hl djnz initscales0 LD H,#C1 INIRETAB0 ; LD L,0 LD B,maxscale+1 INIRETAB1 ; LD A,(HL) CP 128-(scrhgtpix/2) jr nc,$+4 LD A,128-(scrhgtpix/2) CP 128+(scrhgtpix/2);-1 jr c,$+4 ;LD A,128+(scrhgtpix/2)-1 ;видно линию внизу от переполн-й LD A,0xff&(dropline-(scrbuf+(scrhgtpix/2)-128)) ADD A,+(0xff&scrbuf)+(scrhgtpix/2)-128 LD (HL),A INC L DJNZ INIRETAB1 INC H LD A,H INC A ;#C0XX,#FFXX не трогаем jr nz,INIRETAB0 LD HL,#FF00 LD DE,#FF01 LD BC,maxscale LD (HL),1 LDIR LD IY,23610 EI JP GO if mouse initmouse ei halt ;задержка, чтобы мышка успевала опознаваться - min 2500 тактов для Evo (компа с 280к тактов быстродействия) LD B,75 prosirtime LD DE,(0) ;20 тактов DJNZ prosirtime ;13 тактов ld a, 0x90 out (0x7F), a out (0x5F), a ld bc, 0x0FFDF in h, (c) ld b, 0x0FB in l, (c) dec bin a, (c) cp l ret nz ;jr nz, @detected cp h ret nz ;jr z, @comeon LD A,0xaf ;xor a LD (mouseon),A ;ld hl,0x18+(256*readmousejr) ;"jr" ;ld (readmouse_patch),hl ret endif copyscrcolumns ld c,0x40 call copyscrcolumns_third ld c,0x48 call copyscrcolumns_third ld c,0x50 ;call copyscrcolumns_third copyscrcolumns_third xor a copyscrcolumns0 ld e,a ld d,c;0x40 ld b,0x40 copyscrcolumn1 ld a,(hl) inc hl ld (de),a inc d ld a,d and 7 jr nz,copyscrcolumn1_continue ld a,e sub -32 ld e,a sbc a,a and -8 add a,d ld d,a copyscrcolumn1_continue djnz copyscrcolumn1 inc e ld a,e and 0x1f jr nz,copyscrcolumns0 ret GETTEX IF scale64 LD LY,#40 ELSE LD LY,#80 ENDIF LD BC,#0880 ;B=width/8, C=#80(mask) GETTEX00 ; PUSH BC GETTEX0 CALL GETTEXLINE INC LY IF scale64 == 0 INC LY ENDIF RRC C jr nc,GETTEX0 INC L POP BC DJNZ GETTEX00inc hy,hy;DEC HY,HY RET GETSPR IF scale64 LD LY,#40 ELSE LD LY,#80 ENDIF LD BC,#0880 ;B=width/8, C=#80(mask) GETSPR00 ; PUSH BC GETSPR0 CALL GETSPRLINE INC LY IF scale64 == 0 INC LY ENDIF RRC C jr nc,GETSPR0 INC L POP BC DJNZ GETSPR00 inc hy,hy;DEC HY,HY RET GETTEXLINE PUSH HL if 0 push hl ld a,h or 6 ld h,a ld a,l add a,0xe0 ld l,a ld (hl),0xff ;патчим предпоследнюю линию текстуры цветом пола pop hl endif GETTEXRETRY ; LD (gettexDE),DE ;linelength addr POP HL PUSH HL LD (IY),E IF scale64 == 0 LD (IY+1),E ENDIF INC HY LD (IY),D IF scale64 == 0 LD (IY+1),D ENDIF DEC HY INC E jr nz,GETTEXniD GETTEXiD INC D LD E,0x80;maxscale+1 ld a,d cp 0xc0+(2*16) jr c,GETTEXRETRY ld e,0x40 ;дальше нет таблиц адресов JR GETTEXRETRY GETTEXniD ; LD LX,0;C ;bit LD HX,17 ;17-pixels LD B,62 ;62..1 -> 1..62 GETTEX1 ; CALL DHL LD A,(HL) AND C CP LX LD LX,A jr z,GETTEXN LD A,HX OR A jr z,GETTEXN ;can't add more pixels LD A,tscale/256+63 SUB B LD (DE),A DEC HX ;17-pixels INC E ;todo check before write jr z,GETTEXiD GETTEXN ; DJNZ GETTEX1 LD A,HX ;17-pixels ADD A,A ADD A,A ADD A,A SUB HX ;(17-pixels)*7 ADD A,DWJP&0xff gettexDE=$+1 LD (0),A if 1 ;сравнение с предыдущими столбцами push de push iy ld hl,(gettexDE) GETTEX_cmpnext ld a,ly cp 0x40 ;ниже этого tscales jr nz,GETTEX_cmpgo ld a,hy cp 0xc0 jr z,GETTEX_endcmp ld ly,0x7f dec hy,hy GETTEX_cmpgo dec ly ld e,(iy) inc hy ld d,(iy) dec hy ld a,17+1 sub hx ;17+1-(17-pixels) ld b,a ;=1+pixels (min=2из-за линии пола) GETTEX_cmp1 ld a,(de) cp (hl) jr nz,GETTEX_cmpnext inc hl inc de djnz GETTEX_cmp1 ;поставить ссылку на прошлую копию ld e,(iy) inc hy ld d,(iy) pop iy pop af;de LD (IY),e INC HY LD (IY),d DEC HY ld de,(gettexDE) ;откатить DE jr GETTEX_endcmpq GETTEX_endcmp pop iy pop de GETTEX_endcmpq endif POP HL RET GETSPRLINE PUSH HL GETSPRRETRY ; POP HL PUSH HL LD (IY),E IF scale64 == 0 LD (IY+1),E ENDIF INC HY LD (IY),D IF scale64 == 0 LD (IY+1),D ENDIF DEC HY LD A,H OR 6 LD H,A LD A,L ADD A,#E0 LD L,A ;line 62 LD HX,1 GETSPR1 ; CALL FIND10 jr nc,GETSPRQ ;end of column LD A,HX CPL LD (DE),A ;Y INC E jr z,GETSPRiD CALL FIND1HEIGHT LD A,HX CPL LD (DE),A ;Y2 INC E jr z,GETSPRiD CALL FIND0HEIGHT LD A,HX CPL LD (DE),A ;Y3 INC E jr z,GETSPRiD JR GETSPR1 GETSPRQ LD A,#C0 LD (DE),A INC E jr nz,GETSPRniD GETSPRiD INC D LD E,0x80;maxscale+1 ld a,d cp 0xc0+(2*16) jr c,GETSPRRETRY ld e,0x40 ;дальше нет таблиц адресов JR GETSPRRETRY GETSPRniD ; LD A,#FF LD (DE),A INC E jr nz,$+5 INC D LD E,maxscale+1 POP HL RET maxVhgt=10;16? ;HX=V ;HL=mask FIND10 LD A,HX CP 63 RET Z ;CY=0: end of column CALL GETPIXEL RET C ;CY=1: pixel CALL UHL INC HX ;V JR FIND10 FIND1HEIGHT ;LD LX,HX ;oldV LD B,0 F1H0 CALL GETPIXEL RET NC ;transparent RET Z ;0 CALL UHL INC HX ;V INC B LD A,B CP maxVhgt jr c,F1H0 RET FIND0HEIGHT ;LD LX,HX ;oldV LD B,0 F0H0 CALL GETPIXEL RET NC ;transparent RET NZ ;1 CALL UHL INC HX ;V INC B LD A,B CP maxVhgt jr c,F0H0 RET GETPIXEL LD A,HX CP 63 RET Z ;CY=0: transparent LD A,(HL) AND C RET NZ ;CY=0: transparent RES 3,L LD A,(HL) AND C SET 3,L SCF ;CY=1: pixel (Z) RET UHL LD A,H DEC H AND 7 RET NZ LD A,L SUB #20 LD L,A RET C LD A,H ADD A,8 LD H,A RET ;endall DS #C000-$ if 0 ;ORG #C000 IF scale64 IF scale64 == 3 INCBIN "tscale3" ELSE INCBIN "tscale2" ENDIF ELSE INCBIN "tscale" ENDIF endif ;page pgtmp ;ORG #C000,pgtmp hicode_begin ;ds 0x10000-0x1800-0x0800-$ ;0xс040..7f содержит таблицы адресов текстуры (16 текстур?) ds 0x10000-0x1800-0x1000-$ ;0xс040..7f содержит таблицы адресов текстуры (16 текстур?) waswalls incbin "walls.bin";INCBIN "walls_bw",0x1800 wasgoods incbin "goods.bin";INCBIN "goods_bw",0x1800 hicode_end end page 0 savebin "code.c",begin,end-begin ;page pgtmp ;savebin "hicode.c",hicode_begin,hicode_end-hicode_begin LABELSLIST "../../../us/user.l",1