;==========================================================================
;=== 3D engine 0.09 от Alone Coder '2012-2021
;=== модификация от Dragons' Lord  '2021
;==========================================================================

	device pentagon1024
        ;device zxspectrum128

ATM=0;1
VIDEOMODE=0xa8;0xab
scrbase=0x0000+4
FLOORON=0;1
SHOWFPSON=1
SHOWXYZON=0

;basetime=0

;STACK=#6000;#be00;#5fe0;#be00
;drawsp=#5f00

main=#8000;#6400
progtable=#4000
makers=#4100

SMALLLINES=0;1 ;большой набор процедур коротких линий
LINEEX=0 ;чередовать начало-конец линии

TWOAXES=1;0 - включить крены
xbase=#80;#c0 ;#80 только при scrbuf=#d000+: scf:rr h:sra h???
ybase=#80;#c0 ;#80 удобнее сравнивать (по CY - можно высоты >128) ;при #80+(scrhgt/2) проблема с переполнением в большую сторону - линии не туда
;todo 0? (сравнения по PE)

NOISECLS=0;2 ;0=очистка, 1=шум, 2=пропуск байтов
       if ATM
BACKGROUND=0
       else
BACKGROUND=#e000 ;показывать фоновую картинку оттуда (0=не показывать)
;ширина 128 знакомест, высота 128 пикс - итого 16K
BACKGROUNDHGT=64;128
       endif

INTERLACE=0;1
interlacedivisor=1+INTERLACE ;2 for interlace

scrhgt=152/interlacedivisor ;152  /  112 176 192
scrwid=32
	if SMALLLINES&&(xbase != #80)
scrbuf=#d000+ybase-(scrhgt/2) ;#e080+#10
	else
;scrbuf=#e000+ybase-(scrhgt/2) ;#e080+#10
scrbuf=#6000+ybase-(scrhgt/2) ;#e080+#10
	endif
        
        ;display "scrbuf=",/D,scrbuf
        
scrbrim=(32-scrwid)/2
scrtop=#4000
;scrbottomend=#5800-scrbrim
scrbufmid=(scrbuf&#ff00)+#1000

       if ATM
endfree=#e000
       else
endfree=#e000
       endif

	if SMALLLINES
;только для xbase=#c0!!! и уже глючит
endfree=endfree-#100 ;из-за выскакивающих по X линий (max 8 pix)
;linemaxhgt=31 ;63 segments
;jumptable=#a000
linemaxhgt=7 ;15 segments
jumptable=endfree-(256*(linemaxhgt*2+1)) ;=#d000
jumptable_center=jumptable+(linemaxhgt*256)
;сейчас линии занимают #9409..#a93e
;todo не генерировать линии вверх, делать jp на линии вниз (будет неточно?)
endfree=jumptable
	endif

DIVCHECKOVERFLOW=1 ;1=проверка переполнения за двойной экран (если не проверять, то рандомный результат вне экрана (нас устраивает), но при делении через квадраты вообще рандомный результат (нас не устраивает)) ;2=урезание делимого до DIVMAX
;DIVMAX=#49;#40 заметно; #50 еле заметно; #70 незаметно ;#a0 надо по теории для 7.5/6.5
rangeshiftmax=4
MATRIXDIV2=1
MINZ=#00 ;#16..#18 (редкие пропадания на половинных гранях) ;#1e (нет пропаданий на половинных гранях) ;#30 (в теории для кубика с единичными гранями, но плохо выглядят плитки на полу, т.к. сильно ограничен видимый размер)
SORTLEVELS=128 ;256 (разница 8000t только за счёт количества и 3000t ещё за счёт терминатора)
FASTROTOBJ=1 ;быстрое вращение объекта с инлайновым умножением через патчи

VISIBILITY16=1;1 ;при 2 только близкие объекты (range=0,1) считаются в 16 битах, при 0 все 8 бит (косяки при range=0,1), при 1 все 16 бит

sz=8;31;70 ;NU для куба, рассматривается просто как положительное значение

       if ATM
br0=0
br1=1*9+0xc0
br2=2*9
br3=4*9
br1a=5*9
br3a=6*9
br4=0xff
       else
_coltab=32*2+3;coltab&#ff
br0=_coltab;#00
br1=_coltab+2;#41
br2=_coltab+4;#5a
br3=_coltab+6;#d7
br1a=_coltab+8;#50
br3a=_coltab+10;#c3
br4=_coltab+12;#ff
       endif

_tables=endfree
	macro BEGIN256 size
_codes=$
	org _tables-size
	.ALIGN 256
_tables=$
	endm
	macro END256
	org _codes
	endm

	org #6000

begin
        ei ;не закомменчивать и не стирать, иначе на некоторых эмулях в некоторых режимах проект не запускается
        halt
        call initmouse
        di

        xor a
	out (#fe),a            ;Border в чёрный
	ld hl,#5800;+64
	ld de,#5801;+64
	ld bc,767;-256-64
	ld (hl),0               ;Инк в чёрный
	ldir

	ld hl,ON_INT
	ld de,IMER
	ld bc,szON_INT
	ldir
	
	ld hl,wasmakers
	ld de,makers
	ld bc,szmakers
	ldir
	
	;ld (#5d10),a ;for TR-DOS
	;ld (iy+1),#cc ;"128K basic off"
	ld sp,STACK
        ;call makers

	;ld hl,#4000
	;ld de,#4001
	;ld bc,#17ff
	;ld (hl),l
	;ldir

	 ld bc,#fbdf
	 in a,(c)
	 ld (oldfbdf),a
	 ld bc,#ffdf
	 in a,(c)
	 ld (oldffdf),a

	;ei
	;halt
        if ATM
        ld bc,0xbd77 ;включить порты и палитру
        ;ld bc,0xfd77 ;включить порты
        ld a,VIDEOMODE;0xab ;bit2..0 = videomode
        call outdos
        ;ld a,0x7f-1
        ;call setpg0000

        ;ld bc,0x4022
        ;ld e,9
        ;ld h,10
        ;ld l,5
;h=y, l=x/2
;b=hgt,c=wid (/2)
;e=gfx byte
        ;call climgega_xy
        endif

	ld hl,IMVEC&#ff00
	ld a,h
	ld i,a
	;if ((IMVEC+256)&#ff00)==(IMER&#ff00)
	inc a
	;else
	;ld a,IMER/256
	;endif
	ld (hl),a
	inc l
	jr nz,$-2
	inc h
	ld (hl),a
	im 2
	ld a,(timer)
	ld (oldtimer),a
	;jp waithalt
	;ld (scriptsp),sp
	
        call interface
	jp makers;maingo

initmouse
      ;задержка, чтобы мышка успевала опознаваться - 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 b
  in a, (c)
  cp l
  ret nz ;jr nz, @detected
  cp h
  ret nz ;jr z, @comeon
        ld a,0xc9 ;"ret"
        ld (readmouse),a
        ret

;ИНТЕРФЕЙС - отрисовывается только 1 раз
interface
interfaceflag=$+1
         ;ld a,0
         ;cp 0
         ;ret nz
         
        ;ld hl,scrCockpite
	;ld de,#4000
	;ld bc,2048
	;ldir 
        ld hl,scrCockpite+2048
	ld de,#4000+4096
	ld bc,2048
	ldir 
        ;ld hl,scrCockpite+6144
	;ld de,#5800
	;ld bc,32
	;ldir 
        ;ld hl,scrCockpite+6144+256
	;ld de,#5800+512
	;ld bc,256
	;ldir 
        
        ;xor a
        ;ld (azimuth),a
        ;ld (frame_azimuth),a
        ;ld (tangage),a
        ;ld (frame_tangage),a          
        
        ;ld a,1
        ;ld (interfaceflag),a 
        ret
        

        display "---------- 24832 .. ",/D,$," size ",/D,$-begin
        display "---------- ",/D,$," .. 32768 free ",/D,main-$
scrCockpite
        incbin "interface_zx.scr"

;=====================================
     
	;ds main-$
	org main
mainloop
        ;call interface
        call drawframe_prepare
       if !ATM
        call copyscreencls
       endif
       if BACKGROUND
;ищем центр y панорамы
        ;ld a,(frame_tangage)
       ;neg
       ;add a,a
	ld hl,(frame_tangage)
        ld h,tsindiv2/256
        ld a,(hl)               ;sin 
       if !INTERLACE
        add a,a
       endif
        cpl
;
        ld l,a
        rla
        sbc a,a
        ld h,a ;hl=centery
       ;add hl,hl
        ld de,-BACKGROUNDHGT ;для панорамы, симметричной отн. линии горизонта, надо /2
        add hl,de
        ex de,hl ;hl=topy
        ld hl,BACKGROUNDHGT;128
        add hl,de ;hl=bottomy(+1)
;усекаем до -scrhgt/2..+(scrhgt/2(+1))
        ld bc,-(scrhgt/2)
        or a
        sbc hl,bc
        add hl,bc
        jp m,bgq ;bottomy<=-(scrhgt/2)
        ld bc,+(scrhgt/2)
        or a
        sbc hl,bc
        add hl,bc
        jp m,bgnocropbottom
        ld h,b
        ld l,c
bgnocropbottom
        xor a ;picgfx y
        ex de,hl
        ;or a
        sbc hl,bc
        add hl,bc
        jp p,bgq ;topy>=scrhgt
        ld bc,-(scrhgt/2)
        or a
        sbc hl,bc
        add hl,bc
        jp p,bgnocroptop
;hl<bc
        ld a,c
        sub l
        jp m,bgq
        ld h,b
        ld l,c
bgnocroptop
;de=bottomy(+1)<=(scrhgt/2(+1))
;hl=topy>=-(scrhgt/2)
;a=picgfx y
        ex de,hl
        or a
        sbc hl,de ;hgt
        jr z,bgq ;hgt=0
       push de
        ld d,BACKGROUND/256
        ld e,a ;picgfx y
        ld a,l ;draw hgt
        cp BACKGROUNDHGT;128
        jr c,$+4
         ld a,BACKGROUNDHGT;128
        ld c,a
;c=1..BACKGROUNDHGT;128
        ld a,(frame_azimuth)
        srl a
        ld h,a
        ld l,0
        srl h
        rr l
       if BACKGROUNDHGT==64
        srl h
        rr l
       endif
        add hl,de
       pop de
        ld d,scrbuf/256
       ld a,e ;topy (signed)
       add a,ybase -16
        add a,-2; сделаем горизонт чуть повыше
       ld e,a
        ld b,32
        ;ld c,128
;рисуем столбцами высотой c
drawbg0
        push bc
        push de
        push hl
       ld a,0xff
      dup 16
       ld (de),a
       inc e
      edup
       xor a
        ld b,a;0
        ldir
      dup 16
       ld (de),a
       inc e
      edup
       org $-1
        pop hl
        pop de
        ld bc,BACKGROUNDHGT;128
        add hl,bc
        ld a,h
        or BACKGROUND/256 ;for BACKGROUNDend=0
        ld h,a
        inc d ;scrbuf
        pop bc
        djnz drawbg0
bgq
       endif
       if FLOORON
        call drawframe_floor   ;26000 тактов - отрисовать горизонт с кренами
       else
       if !BACKGROUND
        call horizont          ;2000 тактов - отрисовать быстрый горизонт без кренов
       endif
       endif
        call drawframe_lunohod
        call drawframe_show
       if !ATM
	ld hl,framesdrawn
	inc (hl)
paws
	ld a,#ef
	in a,(#fe)
	rra
	jr nc,paws
       endif
waithalt
	ld a,(timer)
oldtimer=$+1
	ld e,0
	ld (oldtimer),a
	sub e
	jp z,waithalt;mainloop
	ld b,a
timeraction0
	push bc
	;call scripting
;curmove=$+1
	call movecube
	pop bc
	djnz timeraction0
	;ld de,basetime+(192*9)-18;15
	;ld hl,(timer)
	;or a
	;sbc hl,de
	;jp c,mainloop
quit
	jp mainloop
outdos
        ld hl,10835
        push hl
        jp 0x3d2f

       if 0;ATM
climgega_xy
;h=y, l=x/2
;b=hgt,c=wid (/2)
;e=gfx byte
       push bc
        ld a,l
        ld c,h
;a=x
;c=y
        ld b,0
        ld l,c ;y
        srl a ;x bit 0
         ld h,b;0
         rl h
         ;inc h
        srl a ;x bit 1
         rl h ;0x00/32/2 или 0x40/32/2
        add hl,hl
        add hl,hl
        add hl,bc
        add hl,hl
        add hl,hl
        add hl,hl ;y*40+scrbase
         if scrbase&0xff
         add a,scrbase&0xff
         endif
;a=x/4
        add a,l
        ld l,a
        adc a,h
        sub l
        ld h,a
       pop bc
climgega_onescreen
;b=hgt,c=wid (/2)
;e=gfx byte
;hl=scr
climgega0
        push bc
        ld hx,b
        push hl
        ld bc,40
climgegacolumn0
        ld (hl),e
        add hl,bc
        dec hx
        jr nz,climgegacolumn0
        pop hl
;0x0000,0x4000,0x2000,0x6000,0x0001
        bit 6,h
        set 6,h
        jr z,climgegacolumn0q
        ld a,h
        xor 0x60
        ld h,a
        and 0x20
        jr nz,climgegacolumn0q
        inc hl
climgegacolumn0q
        pop bc
        dec c
        jr nz,climgega0
        ret
       endif

        ds 32;64
drawsp
        ds 32;64
STACK

mcamx
        dw 0
mcamy
	dw 0
mcamz
	dw 0

	include "rotmatrix.asm"
	include "rotate.asm"
        
                display ">>> ORG - start my level ",/D,$
                include "rotmodel.asm"
                include "3dmodel.asm"
                include "my_lunohod.asm"
                display ">>> ORG - end my level ",/D,$
                
	include "script.asm"  
	include "drawframe.asm"               
	include "rotobj.asm"                
	include "visibility.asm"
       if FLOORON
	include "floor.asm"
       endif
	include "drawedges.asm"
	include "drawfaces.asm"
       if !ATM
	include "display.asm"
        include "my_interface.asm"
       endif

	include "sortobj.asm"
        

                
;сейчас начальная сцена с 5 фигурами в среднем 205000t = 200xxxt...209xxxt (203000 = 197xxx...207xxx)
; 77525t copyscreen чересстрочно весь экран с полной очисткой - очистка заменится на бокс
; 11340t ROTATE_OBJECT (5*2268, т.к. все видимы) - невидимые 633t --- fixed будет 5000t
; 30000t? (inline) ROTATE_VERTICES
; 12870t (восьмибитное) checkvisibility (5*2574)
; 54000(53000)t drawfaces (без них 151000 (150000)) - у цикла переброски 30 проходов по 501t = 15000! плюс от DRWPOLY до DRS1_ = 1533..1548..1576..1660t (15 таких проходов)
;---- сумма = 185xxx(184xxx)
; 20xxx(19xxx)t накладные расходы (сортировка 16000t) --- fixed теперь сортировка 5000t

;надо ускорить выпуклые объекты через инлайн, но с возможностью подключения невыпуклых (с собственной сортировкой)

;если залить весь экран двумя полигонами, то только обвязка займёт 200*200=40000t
;и ещё заливка 11*3000=33000t

;со всеми 25 объектами, полом и потолком при scrhgt=64:
;438000:
;103687 floor+ceiling
; 47263 obj
;232000 sortpop, из них:
     ;2000t сам цикл прохода сортировки
     ;6525t (25*261) чтение объектов, переход на объекты, стек, возврат и вход в цикл снова
     ;18900t (3*6300 ровно) вход и построение матрицы с засечками (вызывается 3 раза)
     ;остаток=204575:
     ;50000? (?*????) вращение: ROTWALL=4549, ROTCELL=1768, ROTCURVE=7814, ROTPYRAMID=2532
     ;50000? (?*????) visibility: WALL=1974, CELL=0, CURVE=6219, PYRAMID=2450
     ;100000? (?*????) draw: WALL=11478, CELL=829, CURVE=4010, PYRAMID=7428
; 52011 display
;  3000 накладные расходы

	;.ALIGN 256
	BEGIN256 256
tcos
	INCBIN "cos.$c!" ;не с 0, а с 2*pi*(1/512)??? (для ROTATE_OBJECT)
	END256

	BEGIN256 256
tsindiv2
	INCBIN "sindiv2" ;с 0 (для ROTATE_MATRIX)
	END256
       if 0
        BEGIN256 256
tsinmy  db #80,#83,#86,#89,#8c,#8f,#92,#95,#98,#9c,#9f,#a2,#a5,#a8,#ab,#ae
        db #b0,#b3,#b6,#b9,#bc,#bf,#c1,#c4,#c7,#c9,#cc,#ce,#d1,#d3,#d5,#d8
        db #da,#dc,#de,#e0,#e2,#e4,#e6,#e8,#ea,#ec,#ed,#ef,#f0,#f2,#f3,#f5
        db #f6,#f7,#f8,#f9,#fa,#fb,#fc,#fc,#fd,#fe,#fe,#ff,#ff,#ff,#ff,#ff
        db #ff,#ff,#ff,#ff,#ff,#ff,#fe,#fe,#fd,#fc,#fc,#fb,#fa,#f9,#f8,#f7
        db #f6,#f5,#f3,#f2,#f0,#ef,#ed,#ec,#ea,#e8,#e6,#e4,#e2,#e0,#de,#dc
        db #da,#d8,#d5,#d3,#d1,#ce,#cc,#c9,#c7,#c4,#c1,#bf,#bc,#b9,#b6,#b3
        db #b0,#ae,#ab,#a8,#a5,#a2,#9f,#9c,#98,#95,#92,#8f,#8c,#89,#86,#83
        db #80,#7c,#79,#76,#73,#70,#6d,#6a,#67,#63,#60,#5d,#5a,#57,#54,#51
        db #4f,#4c,#49,#46,#43,#40,#3e,#3b,#38,#36,#33,#31,#2e,#2c,#2a,#27
        db #25,#23,#21,#1f,#1d,#1b,#19,#17,#15,#13,#12,#10,#0f,#0d,#0c,#0a
        db #09,#08,#07,#06,#05,#04,#03,#03,#02,#01,#01,#00,#00,#00,#00,#00
        db #00,#00,#00,#00,#00,#00,#01,#01,#02,#03,#03,#04,#05,#06,#07,#08
        db #09,#0a,#0c,#0d,#0f,#10,#12,#13,#15,#17,#19,#1b,#1d,#1f,#21,#23
        db #25,#27,#2a,#2c,#2e,#31,#33,#36,#38,#3b,#3e,#40,#43,#46,#49,#4c
        db #4f,#51,#54,#57,#5a,#5d,#60,#63,#67,#6a,#6d,#70,#73,#76,#79,#7c
	END256        
       endif
       if !ATM
showfps 
;out: a=50
       if SHOWFPSON
	ld a,(framesdrawn)
	push de
	ld de,#50e0;#401d
	ld bc,10-256
	inc b
	sub c
	jr nc,$-2
	add a,c
	ld c,a
	ld a,b
	call showdig
	ld a,c
	call showdig
	pop de
	xor a
	ld (framesdrawn),a
       endif
	ld a,50
	ret
showdig	
	add a,"0"
	push de
	add a,a
	ld h,15
	ld l,a
	add hl,hl
	add hl,hl
	ld b,8
showdig0
	ld a,(hl)
	ld (de),a
	inc l
	inc d
	djnz showdig0
	pop de
	inc e
	ret
framesdrawn
	db 0
       endif

imer_main
	ld hl,(timer)
	inc hl
	ld (timer),hl
       if !ATM
timersec=$+1
	ld a,1
	dec a
	call z,showfps ;out: a=50
	ld (timersec),a
       endif
        ;call readmouse
        ;jp movecube
readmouse
        if ATM
        ld bc,0x3ff7
        ld a,0x83 ;basic48
        out (c),a
        ld bc,0xff77
        ld a,VIDEOMODE;0xab
        out (c),a
        endif

       ld bc,0xffdf ;mouse y
       in h,(c)
       ld b,0xfb ;mouse x
       in l,(c)
       ld (curmousexy),hl
       ;dec b ;ld b,0xfa
       ;in a,(c)
       ;ld (curmousekeys),a
        if ATM
        ld bc,0xbd77
        ld a,VIDEOMODE;0xab
        call outdos
curpg0000=$+1
        ld a,0;(curpg0000)
        ld bc,0x3ff7
        out (c),a
        endif
       ret

       if ATM
setpgsscr
        ld a,(curpgscr)
        ;call setpg0000
;setpg0000
        ld (curpg0000),a
        ld bc,0x3ff7
        out (c),a
        ;ret
        xor 4
        ;ld (curpg4000),a
        ld b,0x7f;bc,0x7ff7
        out (c),a
        ret

clearscreen
        call setpgsscr
        ;ld hl,0
        ;ld de,1
        ;ld bc,0x6000+7999
        ;ld (hl),0
        ;ldir
       ld (clearscreensp),sp
       ld sp,0x8000
        xor a
        ld d,a
        ld e,a
clearscreen0
        dup 64
        push de
        edup
        dec a
        jp nz,clearscreen0
clearscreensp=$+1
        ld sp,0
        ret

;curpg0000
;        db 0x7f-0
;curpg4000
;        db 0x7f-5
curpgscr
        db 0x7f-1 ;3
curscrnum
        db 0x18
       endif

	BEGIN256 512
IMVEC=$+#ff
IMER=(($/#100)+1)*#101
IMERSP=IMER
	ds #101,#ff&IMER
	END256
;IMER=#cfcf
;IMERSP=IMER
;IMVEC=#ceff;#3bff
;endfree=endfree-#200

prog
        display "active end=",prog
maingo
;********************************************************************
        ;call makers
	ld hl,#4000
	ld de,#4001
	ld bc,#0800;#1800
	ld (hl),l
	ldir
        ld h,#58;hl,#5800;+32
	ld d,h;de,#5801;+32
	ld bc,767;-256-32
	ld (hl),%00000111       ;GRB - Инк игрового экрана
	ldir
        ei
        jp waithalt

	;if IMVEC!=#3bff
ON_INT
;по прерыванию в стек пишется de
	disp IMER
	 ex de,hl
	ex (sp),hl ;hl запомнили, вспомнили адрес возврата
	ld (IMERjp),hl
	pop hl ;вспомнили hl
	 ex de,hl
	ld (IMERwassp),sp
	;push de ;пишем de
	ld sp,IMERSP
	push af,bc,hl
        call imer_main;readmouse
	;push de
	;push ix,iy
	;ld a,(curpg)
	;push af
	;ld a,pgmuz
	;call OUTA
	;;call muz+5
	;pop af
	;call OUTA
	;pop iy,ix
	;pop de
	pop hl,bc,af
IMERwassp=$+1
	ld sp,0
	ei
IMERjp=$+1
	jp 0
timer
	dw 0
	ent
szON_INT=$-ON_INT
	;endif

wasmakers
	disp makers
        include "makers.asm"
	ent
szmakers=$-wasmakers


        display "_tables=",_tables
        display "---------- 32768 .. ",/D,$," size ",/D,$-32768
        display "---------- ",/D,$," .. ",/D,_tables,"(_tables) free ",/D,_tables-$    
        display "---------- ",/D,prog," .. ",/D,_tables,"(_tables) free for object list ",/D,_tables-prog    
        ;display "---------- ",/D,$," .. 56391 free ",/D,56391-$         
	;display "beginfree=",/D,prog
	;display "_tables=",/D,_tables
	;display "endfree=",/D,endfree
        org endfree
       if !ATM
        incbin "panorama.bin"
       endif
endall

        ;ORG 52736
endtables=_tables ;for sortobj
	;ds _tables-$ ; 3655 = длина таблиц        
        display ">>> ORG _tables ",/D,_tables

	;display "Size ",/d,end-begin," bytes"
	;display "Size ",/d,endfree-begin," bytes"
        
	savebin "code.c",begin,endall-begin
	;savebin "code.c",begin,endfree-begin
        ;savesna "elite.sna",begin
	
	;LABELSLIST "..\us\user.l"
