古いＣＰＵの話題が多いです


リンクその４： ３Ｄ ｇｒａｐｈｉｃｓ プロジェクト（MZ80B編）

;3D graphics ver.2.21 for MZ-80B (C) 1991, 2008, 2017

org &12a0, &12a0

jp start
jp hotstart

;*******
test: call init

ld hl,50
ld [p4_x1],hl
ld hl,50
ld [p4_y1],hl
ld hl,100
ld [p4_x2],hl
ld hl,50
ld [p4_y2],hl
ld hl,100
ld [p4_x3],hl
ld hl,100
ld [p4_y3],hl
ld hl,50
ld [p4_x4],hl
ld hl,100
ld [p4_y4],hl

test00: call clsc
call clsv
ld hl,p4_x1
ld de,p40_x1
ld bc,(2+2)*4
ldir
call p4_line

ld hl,[test_cursor]
add hl,hl
add hl,hl
ld de,p4_x1
add hl,de
ld [test_cursorptr],hl

ld e,[hl]
inc hl
ld d,[hl]
ld [dr_x1],de
ld [dr_x2],de
ld hl,0
ld [dr_y1],hl
ld hl,199
ld [dr_y2],hl
call line

ld hl,[test_cursorptr]
inc hl
inc hl
ld e,[hl]
inc hl
ld d,[hl]
ld [dr_y1],de
ld [dr_y2],de
ld hl,0
ld [dr_x1],hl
ld hl,319
ld [dr_x2],hl
call line

test10: call keywait
cp 11
jp z,_monitor
cp '1'
jr z,test11
cp '3'
jr z,test13
cp '2'
jr z,test12
cp '4'
jr z,test14
cp '6'
jr z,test16
cp '8'
jr z,test18
cp 13
jr nz,test10

ld a,1
ld [vvactive],a
call p4_polygon
jr test10

test11: ld a,[test_cursor]
dec a
test110:
and 3
ld [test_cursor],a
jp test00

test13: ld a,[test_cursor]
inc a
jr test110

test12: ld hl,[test_cursorptr]
inc hl
inc hl
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
ld bc,5
add hl,bc
ex de,hl
ld [hl],d
dec hl
ld [hl],e
jp test00

test18: ld hl,[test_cursorptr]
inc hl
inc hl
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
ld bc,-5
add hl,bc
ex de,hl
ld [hl],d
dec hl
ld [hl],e
jp test00

test14: ld hl,[test_cursorptr]
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
ld bc,-5
add hl,bc
ex de,hl
ld [hl],d
dec hl
ld [hl],e
jp test00

test16: ld hl,[test_cursorptr]
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
ld bc,5
add hl,bc
ex de,hl
ld [hl],d
dec hl
ld [hl],e
jp test00

test_cursor: dw 0
test_cursorptr: dw 0
;*******

cr_x1: dw 0
cr_y1: dw 0
cr_x2: dw 0
cr_y2: dw 0
cr_x3: dw 0
cr_y3: dw 0
cr_x4: dw 0
cr_y4: dw 0
cr_x5: dw 0
cr_y5: dw 0
cr_y1y2: dw 0
cr_y1y3: dw 0
cr_y3y4: dw 0
cr_u: dw 0
crre_u: db 0,0,0,0,0,0
cr_us: dw 0
cr_ut: dw 0
crre_s: db 0,0,0,0,0,0
crre_t: db 0,0,0,0,0,0
cr_flag: db 0

cross: ;(cr_x1,cr_y1)-(cr_x2,cr_y2)と(cr_x3,cr_y3)-(cr_x4,cr_y4)の交点を計算する
;cf=0ならば交点は(cr_x5,cr_y5)に入っている

;y1y2=y1-y2
ld hl,[cr_y1]
ld de,[cr_y2]
call isub
ret c
ld [cr_y1y2],hl
;y1y3=y1-y3
ld hl,[cr_y1]
ld de,[cr_y3]
call isub
ret c
ld [cr_y1y3],hl
;y3y4=y3-y4
ld hl,[cr_y3]
ld de,[cr_y4]
call isub
ret c
ld [cr_y3y4],hl

;u= (x3 - x4) * y1y2
ld hl,[cr_x3]
ld de,[cr_x4]
call isub
ret c
ex de,hl
ld bc,[cr_y1y2]
call imul
ret c
ld [cr_u],hl
; - (x1 - x2) * y3y4
ld hl,[cr_x1]
ld de,[cr_x2]
call isub
ret c
ex de,hl
ld bc,[cr_y3y4]
call imul
ret c
ex de,hl
ld hl,[cr_u]
call isub
ret c
ld [cr_u],hl

;if( u .ne. 0.0_8 ) then
ld a,h
or l
scf
ret z

call itof16
ld hl,acc1
ld de,crre_u
call mtom

;us= x4 * y1y3
ld de,[cr_x4]
ld bc,[cr_y1y3]
call imul
ret c
ld [cr_us],hl
; + x1 * y3y4
ld de,[cr_x1]
ld bc,[cr_y3y4]
call imul
ret c
ex de,hl
ld hl,[cr_us]
call iadd
ret c
ld [cr_us],hl
; + x3 * (y4 - y1)
ld hl,[cr_y4]
ld de,[cr_y1]
call isub
ret c
ex de,hl
ld bc,[cr_x3]
call imul
ret c
ex de,hl
ld hl,[cr_us]
call iadd
ret c
ld [cr_us],hl

;ut= x3 * y1y2
ld de,[cr_x3]
ld bc,[cr_y1y2]
call imul
ret c
ld [cr_ut],hl
; + x1 * (y2 - y3)
ld hl,[cr_y2]
ld de,[cr_y3]
call isub
ret c
ex de,hl
ld bc,[cr_x1]
call imul
ret c
ex de,hl
ld hl,[cr_ut]
call iadd
ret c
ld [cr_ut],hl
; - x2 * y1y3
ld de,[cr_x2]
ld bc,[cr_y1y3]
call imul
ret c
ex de,hl
ld hl,[cr_ut]
call isub
ret c
ld [cr_ut],hl

;s= us / -u
ld hl,[cr_us]
call itof16
ld hl,acc1
call chs
call mtox
ld hl,crre_u
call mtox
call div
ld hl,crre_s
call xtom

;t= ut / u
ld hl,[cr_ut]
call itof16
ld hl,acc1
call mtox
ld hl,crre_u
call mtox
call div
ld hl,crre_t
call xtom

;if( s .ge. 0.0_8 ) then
;if( s .le. 1.0_8 ) then
;if( t .ge. 0.0_8 ) then
;if( t .le. 1.0_8 ) then
ld hl,crre_s
push hl
call is0
pop hl
jr z,cro00
ld a,[hl]
add a,a
ret c
ld de,float1
call fcp ;1-s
ret c
cro00:
ld hl,crre_t
push hl
call is0
pop hl
jr z,cro10
ld a,[hl]
add a,a
ret c
ld de,float1
call fcp ;1-t
ret c
cro10:
; x5=x1+(x2-x1)*s
ld hl,[cr_x2]
ld de,[cr_x1]
call isub
ret c
call itof16
ld hl,acc1
call mtox
ld hl,crre_s
call mtox
call mul
ld hl,acc1
call xtom
call ftoi16
ret c
ld de,[cr_x1]
call iadd
ret c
ld [cr_x5],hl

; y5=y1+(y2-y1)*s
ld hl,[cr_y2]
ld de,[cr_y1]
call isub
ret c
call itof16
ld hl,acc1
call mtox
ld hl,crre_s
call mtox
call mul
ld hl,acc1
call xtom
call ftoi16
ret c
ld de,[cr_y1]
call iadd
ret c
ld [cr_y5],hl

;end if
;end if
;end if
;end if

ret ;cf=0

imul: ;整数hl=整数de*整数bc, cf=status(16bitx8bitに収まらないときはエラー)
xor a
bit 7,d
jr z,imul00
inc a
ex af,af'
ld a,d
cpl
ld d,a
ld a,e
cpl
ld e,a
inc de
ex af,af'
imul00:
bit 7,b
jr z,imul01
inc a
ex af,af'
ld a,b
cpl
ld b,a
ld a,c
cpl
ld c,a
inc bc
ex af,af'
imul01:
ex af,af'
imul10:
ld a,b
and a
jr z,imul11
inc a
jr z,imul11
push bc
push de
pop bc
pop de
ld a,b
and a
jr z,imul11
inc a
scf
ret nz
imul11:
call imulp
ret c
bit 7,h ;正数x正数=負数ならばエラー
scf
ret nz
ex af,af'
and 1
ret z ;cf=0
ld a,h
cpl
ld h,a
ld a,l
cpl
ld l,a
inc hl
and a
ret ;cf=0

imulp: ;正数hl=正数de*正数c, cf=status
ld hl,0
srl c ;1回目
jr nz,imulp00
ret nc ;0
ex de,hl
and a
ret ;cf=0
imulp00:
jr nc,imulp01
ld h,d
ld l,e
imulp01:
ex de,hl ;1回目
add hl,hl
ex de,hl
jr nc,imulp10
ld a,c
and a
ret z ;cf=0
scf
ret
imulp10:
ld a,d
or e
ret z ;0

srl c ;2,3,4,5,6,7,8回目
jr nz,imulp20
;cf=1
add hl,de
ret
imulp20:
jr nc,imulp21
add hl,de
imulp21:
ex de,hl ;2,3,4,5,6,7回目
add hl,hl
ex de,hl
jr nc,imulp10
ret

p3_x1: dw 0
p3_y1: dw 0
p3_x2: dw 0
p3_y2: dw 0
p3_x3: dw 0
p3_y3: dw 0

p30_x1: dw 0
p30_y1: dw 0
p30_x2: dw 0
p30_y2: dw 0
p30_x3: dw 0
p30_y3: dw 0

;double s3(int x1,int y1,int x2,int y2,int x3,int y3) {
; return(fabs(0.5f*((x1-x2)*(y3-y1)+(x1-x3)*(y1-y2))));
; }
sum3: ;[p3_x1]〜の３角形の面積*2→hl, cf=status
;(x1-x2)*(y3-y1)
ld hl,[p3_x1]
ld de,[p3_x2]
and a
sbc hl,de
push hl
ld hl,[p3_y3]
ld de,[p3_y1]
and a
sbc hl,de
ex de,hl
pop bc
call imul
ret c
push hl
;(x1-x3)*(y1-y2)
ld hl,[p3_x1]
ld de,[p3_x3]
and a
sbc hl,de
push hl
ld hl,[p3_y1]
ld de,[p3_y2]
and a
sbc hl,de
ex de,hl
pop bc
call imul
pop de
ret c
call iadd
ret c
bit 7,h
ret z ;cf=0
ld a,h
cpl
ld h,a
ld a,l
cpl
ld l,a
inc hl
and a
ret ;cf=0

isub: ;hl=hl-de(符号付き), cf=status
ld a,d
cpl
ld d,a
ld a,e
cpl
ld e,a
inc de
;
iadd: ;hl=hl+de(符号付き), cf=status
ld a,h
xor d
jp m,iadd00
;同符号
ld a,h
add hl,de
xor h
ret p ;cf=0
scf
ret
iadd00: ;異符号
add hl,de
and a
ret ;cf=0

p3_minx:dw 0
p3_miny:dw 0
p3_maxx:dw 0
p3_maxy:dw 0

p3_sum3:dw 0

p3_polygon: ;[p3_x1]〜の３角形をポリゴンで表示する, cf=status
call sum3
ret c
ld [p3_sum3],hl

ld hl,p3_x1
ld de,p3_minx
push hl
ldi
ldi
ldi
ldi
pop hl
ldi
ldi
ldi
ldi

;最大値、最小値を決める
ld hl,[p3_minx]
ld de,[p3_x2]
and a
sbc hl,de
bit 7,h
jr nz,p3p00
ld [p3_minx],de
p3p00:
ld hl,[p3_minx]
ld de,[p3_x3]
and a
sbc hl,de
bit 7,h
jr nz,p3p01
ld [p3_minx],de
p3p01:
ld hl,[p3_maxx]
ld de,[p3_x2]
and a
sbc hl,de
bit 7,h
jr z,p3p10
ld [p3_maxx],de
p3p10:
ld hl,[p3_maxx]
ld de,[p3_x3]
and a
sbc hl,de
bit 7,h
jr z,p3p11
ld [p3_maxx],de
p3p11:
ld hl,[p3_miny]
ld de,[p3_y2]
and a
sbc hl,de
bit 7,h
jr nz,p3p20
ld [p3_miny],de
p3p20:
ld hl,[p3_miny]
ld de,[p3_y3]
and a
sbc hl,de
bit 7,h
jr nz,p3p21
ld [p3_miny],de
p3p21:
ld hl,[p3_maxy]
ld de,[p3_y2]
and a
sbc hl,de
bit 7,h
jr z,p3p30
ld [p3_maxy],de
p3p30:
ld hl,[p3_maxy]
ld de,[p3_y3]
and a
sbc hl,de
bit 7,h
jr z,p3p31
ld [p3_maxy],de
p3p31:
;点や直線になるポリゴンは表示しない
ld hl,[p3_maxx]
ld de,[p3_minx]
and a
sbc hl,de
ret z ;cf=0
ld hl,[p3_maxy]
ld de,[p3_miny]
and a
sbc hl,de
ret z ;cf=0

ld a,[vvactive]
and a
jr z,p3vv_polygon00
call p3vv_polygon
ret nc
p3vv_polygon00:

ld hl,p3_x1
ld de,p30_x1
ld bc,(2+2)*3
ldir

;描画
ld hl,[p3_miny]
p3p40:
ld [p3_y1],hl
ld de,200
and a
sbc hl,de
jr nc,p3p70

;minx -->
ld hl,[p3_minx]
p3p50:
ld [p3_x1],hl
ld de,[p3_maxx]
and a
sbc hl,de
jr z,p3p53
add hl,de
ld de,320
and a
sbc hl,de
jr nc,p3p51

call inner123
ret c
jr z,p3p52
p3p51:
ld hl,[p3_x1]
inc hl
jr p3p50
p3p53:
call inner123
ret c
jr nz,p3p70
p3p52:
ld hl,[p3_x1]
ld [dr_x1],hl

;<-- maxx
ld hl,[p3_maxx]
p3p60:
ld [p3_x1],hl
ld de,[dr_x1]
and a
sbc hl,de
jr z,p3p62
add hl,de
ld de,320
and a
sbc hl,de
jr nc,p3p61

call inner123
ret c
jr z,p3p62
p3p61:
ld hl,[p3_x1]
dec hl
jr p3p60
p3p62:
ld hl,[p3_x1]
ld [dr_x2],hl
ld hl,[p3_y1]
ld [dr_y1],hl
ld [dr_y2],hl
call hline ;横１本を塗る
p3p70:
ld hl,[p3_y1]
inc hl
ld de,[p3_maxy]
and a
sbc hl,de
ret z ;cf=0
add hl,de
jr p3p40

inner123: ;[p3_x1],[p3_y1]の[p30_x1〜4],[p30_y1〜4]の内包判定, cf=status, zf=1ならば内側にある
;p30の面積は[p3_sum3]に入れておく
;p12
ld hl,[p30_x1]
ld [p3_x2],hl
ld hl,[p30_y1]
ld [p3_y2],hl
ld hl,[p30_x2]
ld [p3_x3],hl
ld hl,[p30_y2]
ld [p3_y3],hl
call sum3
ret c
push hl
;p23
ld hl,[p30_x2]
ld [p3_x2],hl
ld hl,[p30_y2]
ld [p3_y2],hl
ld hl,[p30_x3]
ld [p3_x3],hl
ld hl,[p30_y3]
ld [p3_y3],hl
call sum3
pop de
ret c
add hl,de
ret c
push hl
;p31
ld hl,[p30_x3]
ld [p3_x2],hl
ld hl,[p30_y3]
ld [p3_y2],hl
ld hl,[p30_x1]
ld [p3_x3],hl
ld hl,[p30_y1]
ld [p3_y3],hl
call sum3
pop de
ret c
add hl,de
ret c
ld de,[p3_sum3]
;cf=0
sbc hl,de ;△123==△p12+p23+p31で内側にある
ret

p4_x1: dw 0
p4_y1: dw 0
p4_x2: dw 0
p4_y2: dw 0
p4_x3: dw 0
p4_y3: dw 0
p4_x4: dw 0
p4_y4: dw 0

p40_x1: dw 0
p40_y1: dw 0
p40_x2: dw 0
p40_y2: dw 0
p40_x3: dw 0
p40_y3: dw 0
p40_x4: dw 0
p40_y4: dw 0

;double s4(int x1,int y1,int x2,int y2,int x3,int y3,int x4,int y4) {
; return(fabs(0.5f*((x1-x2)*(y3-y1)+(x1-x3)*(y4-y2)+(x1-x4)*(y1-y3))));
; }
sum4: ;[p4_x1]〜の４角形の面積*2→hl, cf=status
;(x1-x2)*(y3-y1)
ld hl,[p4_x1]
ld de,[p4_x2]
and a
sbc hl,de
push hl
ld hl,[p4_y3]
ld de,[p4_y1]
and a
sbc hl,de
ex de,hl
pop bc
call imul
ret c
push hl
;(x1-x3)*(y4-y2)
ld hl,[p4_x1]
ld de,[p4_x3]
and a
sbc hl,de
push hl
ld hl,[p4_y4]
ld de,[p4_y2]
and a
sbc hl,de
ex de,hl
pop bc
call imul
pop de
ret c
call iadd
ret c
push hl
;(x1-x4)*(y1-y3)
ld hl,[p4_x1]
ld de,[p4_x4]
and a
sbc hl,de
push hl
ld hl,[p4_y1]
ld de,[p4_y3]
and a
sbc hl,de
ex de,hl
pop bc
call imul
pop de
ret c
call iadd
ret c
bit 7,h
ret z ;cf=0
ld a,h
cpl
ld h,a
ld a,l
cpl
ld l,a
inc hl
and a
ret ;cf=0

p4_minx:dw 0
p4_miny:dw 0
p4_maxx:dw 0
p4_maxy:dw 0

p4_sum4: dw 0
p4_sum42: dw 0
p4_sum123: dw 0
p4_sum341: dw 0

vvactive: db 0

p4v_start: dw 0 ;vram上の左上のアドレス
p4v_lenx: dw 0 ;x方向の長さ（１バイト単位）（１〜４０）
p4v_leny: dw 0 ;y方向の長さ（１〜２００）

p34_minx: dw 0

p4v_cls: ;仮想vramをクリアする。 (0,0)-(p4v_lenx-1,leny-1)
ld hl,40
ld de,[p4v_lenx]
and a
sbc hl,de
ex de,hl

ld hl,vvr
ld bc,[p4v_leny]
p4vc00:
ld a,[p4v_lenx]
ld b,a
p4vc01:
ld [hl],0
inc hl
djnz p4vc01

add hl,de
dec c
jr nz,p4vc00

ret

p4v_tfr: ;仮想vram1→vram2転送する。 (0,0)-(p4v_lenx-1,leny-1)
ld hl,vvr
ld de,vvr2
ld a,[p4v_leny]
ld b,a
p4vt00:
push bc
push hl
push de

ld bc,[p4v_lenx]
ldir

pop hl
ld c,40 ;b=0
add hl,bc
ex de,hl
pop hl
add hl,bc
pop bc
djnz p4vt00

ret

p4v_xor: ;仮想vram1=not(vram1 xor vram2), (0,0)-(p4v_lenx-1,leny-1)
ld hl,vvr
ld de,vvr2
ld a,[p4v_leny]
ld c,a
p4vx00:
push bc
push hl
push de

ld a,[p4v_lenx]
ld b,a
p4vx01:
ld a,[de] ;vvr2
inc de
xor [hl] ;vvr
cpl
ld [hl],a
inc hl
djnz p4vx01

pop hl
ld c,40 ;b=0
add hl,bc
ex de,hl
pop hl
add hl,bc
pop bc
dec c
jr nz,p4vx00

ret

p4v_or: ;[p4v_start〜]=[p4v_start〜] or [vvr〜], (0,0)-(p4v_lenx-1,leny-1)
in a,[&e8] ;vramアクセス許可
set 7,a
res 6,a
out [&e8],a
ld a,&02
out [&f4],a

ld hl,[p4v_start]
ld de,vvr
ld a,[p4v_leny]
ld c,a
p4vo00:
push bc
push hl
push de

ld a,[p4v_lenx]
ld b,a
p4vo01:
ld a,[de] ;vvr
inc de
or [hl] ;実際のvram
ld [hl],a
inc hl
djnz p4vo01

pop hl
ld c,40 ;b=0
add hl,bc
ex de,hl
pop hl
add hl,bc
pop bc
dec c
jr nz,p4vo00

in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&03
out [&f4],a

ret

p3vv_polygon: ;[p3_x1]〜の３角形をポリゴンで表示する, cf=status
;p3_polygonから呼ばれる
;p3_minx,y,maxx,yも設定済みとする
ld hl,[p3_minx] ;320*200の枠から外れたものは除外する
bit 7,h
scf
ret nz
ld de,320
and a
sbc hl,de
ccf
ret c
ld hl,[p3_maxx]
bit 7,h
scf
ret nz
and a
sbc hl,de
ccf
ret c
ld hl,[p3_miny]
bit 7,h
scf
ret nz
ld de,200
and a
sbc hl,de
ccf
ret c
ld hl,[p3_maxy]
bit 7,h
scf
ret nz
and a
sbc hl,de
ccf
ret c

ld de,[p3_minx] ;下位３ビットを切り捨てる
ld a,e
and &ff-7
ld e,a
ld [p34_minx],de

ld hl,[p3_maxx] ;下位３ビットを切り捨てる
ld a,l
and &ff-7
ld l,a
;cf=0
sbc hl,de

srl h ;最大320/2
rr l
srl l ;最大160/2
srl l ;最大80/2

inc hl
ld [p4v_lenx],hl

ld hl,[p3_maxy]
ld de,[p3_miny]
and a
sbc hl,de
inc hl
ld [p4v_leny],hl

ld h,d ;miny*40
ld l,e
add hl,hl ;*2
add hl,hl ;*4
add hl,de ;*5
add hl,hl ;*10
add hl,hl ;*20
add hl,hl ;*40
ld de,[p34_minx]
srl d ;最大320/2
rr e
srl e ;最大160/2
srl e ;最大80/2
add hl,de ;+minx/8
ld de,&e000
add hl,de
ld [p4v_start],hl

;minx,minyのオフセットを引く
ld de,[p34_minx]
ld hl,[p3_x1]
and a
sbc hl,de
ld [p30_x1],hl
ld hl,[p3_x2]
and a
sbc hl,de
ld [p30_x2],hl
ld hl,[p3_x3]
and a
sbc hl,de
ld [p30_x3],hl

ld de,[p3_miny]
ld hl,[p3_y1]
and a
sbc hl,de
ld [p30_y1],hl
ld hl,[p3_y2]
and a
sbc hl,de
ld [p30_y2],hl
ld hl,[p3_y3]
and a
sbc hl,de
ld [p30_y3],hl

;仮想vramをクリアする
call p4v_cls

;仮想vramに直線を描く
ld hl,vvr
ld [dr_code3+1],hl
call p3_line
ld hl,&e000
ld [dr_code3+1],hl

jp p34vv_polygon

p4vv_polygon: ;[p4_x1]〜の凸型４角形をポリゴンで表示する, cf=status
;p4_polygonから呼ばれるため、凸型のチェック済み
;p4_minx,y,maxx,yも設定済みとする

ld hl,[p4_minx] ;320*200の枠から外れたものは除外する
bit 7,h
scf
ret nz
ld de,320
and a
sbc hl,de
ccf
ret c
ld hl,[p4_maxx]
bit 7,h
scf
ret nz
and a
sbc hl,de
ccf
ret c
ld hl,[p4_miny]
bit 7,h
scf
ret nz
ld de,200
and a
sbc hl,de
ccf
ret c
ld hl,[p4_maxy]
bit 7,h
scf
ret nz
and a
sbc hl,de
ccf
ret c

ld de,[p4_minx] ;下位３ビットを切り捨てる
ld a,e
and &ff-7
ld e,a
ld [p34_minx],de

ld hl,[p4_maxx] ;下位３ビットを切り捨てる
ld a,l
and &ff-7
ld l,a
;cf=0
sbc hl,de

srl h ;最大320/2
rr l
srl l ;最大160/2
srl l ;最大80/2

inc hl
ld [p4v_lenx],hl

ld hl,[p4_maxy]
ld de,[p4_miny]
and a
sbc hl,de
inc hl
ld [p4v_leny],hl

ld h,d ;miny*40
ld l,e
add hl,hl ;*2
add hl,hl ;*4
add hl,de ;*5
add hl,hl ;*10
add hl,hl ;*20
add hl,hl ;*40
ld de,[p34_minx]
srl d ;最大320/2
rr e
srl e ;最大160/2
srl e ;最大80/2
add hl,de ;+minx/8
ld de,&e000
add hl,de
ld [p4v_start],hl

;minx,minyのオフセットを引く
ld de,[p34_minx]
ld hl,[p4_x1]
and a
sbc hl,de
ld [p40_x1],hl
ld hl,[p4_x2]
and a
sbc hl,de
ld [p40_x2],hl
ld hl,[p4_x3]
and a
sbc hl,de
ld [p40_x3],hl
ld hl,[p4_x4]
and a
sbc hl,de
ld [p40_x4],hl

ld de,[p4_miny]
ld hl,[p4_y1]
and a
sbc hl,de
ld [p40_y1],hl
ld hl,[p4_y2]
and a
sbc hl,de
ld [p40_y2],hl
ld hl,[p4_y3]
and a
sbc hl,de
ld [p40_y3],hl
ld hl,[p4_y4]
and a
sbc hl,de
ld [p40_y4],hl

;仮想vramをクリアする
call p4v_cls

;仮想vramに直線を描く
ld hl,vvr
ld [dr_code3+1],hl
call p4_line
ld hl,&e000
ld [dr_code3+1],hl

p34vv_polygon: ;３角形、４角形共通

;仮想vram1→vram2転送する。 (0,0)-(p4v_lenx-1,leny-1)
call p4v_tfr

;仮想vram1の３角形または４角形の外側を塗りつぶす
ld a,[p4v_leny]
ld c,a
ld hl,vvr
p4vv00:
push hl
ld a,[p4v_lenx]
ld b,a
p4vv10:
ld a,[hl]
and a
jr nz,p4vv11
ld [hl],&ff
inc hl
djnz p4vv10
jr p4vv21
p4vv11:
bit 0,a
jr nz,p4vv20
or 1
bit 1,a
jr nz,p4vv20
or 2
bit 2,a
jr nz,p4vv20
or 4
bit 3,a
jr nz,p4vv20
or 8
bit 4,a
jr nz,p4vv20
or 16
bit 5,a
jr nz,p4vv20
or 32
bit 6,a
jr nz,p4vv20
or 64
bit 7,a
jr nz,p4vv20
or 128
p4vv20:
ld [hl],a
p4vv21:
pop hl
push hl

ld de,[p4v_lenx]
add hl,de
ld b,e ;lenx
p4vv30:
dec hl
ld a,[hl]
and a
jr nz,p4vv31
ld [hl],&ff
djnz p4vv30
jr p4vv32
p4vv31:
bit 7,a
jr nz,p4vv40
or 128
bit 6,a
jr nz,p4vv40
or 64
bit 5,a
jr nz,p4vv40
or 32
bit 4,a
jr nz,p4vv40
or 16
bit 3,a
jr nz,p4vv40
or 8
bit 2,a
jr nz,p4vv40
or 4
bit 1,a
jr nz,p4vv40
or 2
bit 0,a
jr nz,p4vv40
or 1
p4vv40:
ld [hl],a
p4vv32:
pop hl
ld de,40
add hl,de
dec c
jp nz,p4vv00

;仮想vram1=not(vram1 xor vram2), (0,0)-(p4v_lenx-1,leny-1)
call p4v_xor

;[p4v_start〜]=[p4v_start〜] or [vvr〜], (0,0)-(p4v_lenx-1,leny-1)
call p4v_or

and a
ret ;cf=0

;四角形1234について
;
;仮説1：その頂点1,2,3,4を使って面積を計算する。
;△123+△234+△341+△412==2*□1234ならば、□1234は凸型である。
;□1234が凸型であれば、□1234をそのまま描画する。
;
;仮説2：□1234が凹型である場合、
;△123+△341==□1234ならば、△123と△341に分けて描画する。
;△123+△341!=□1234ならば、△234と△412に分けて描画する。

p4_polygon: ;[p4_x1]〜の４角形をポリゴンで表示する, cf=status
xor a
ld [cr_flag],a

call sum4
ret c
ld [p4_sum4],hl
add hl,hl
ret c
ld [p4_sum42],hl

;123
ld hl,[p4_x1]
ld [p3_x1],hl
ld hl,[p4_y1]
ld [p3_y1],hl
ld hl,[p4_x2]
ld [p3_x2],hl
ld hl,[p4_y2]
ld [p3_y2],hl
ld hl,[p4_x3]
ld [p3_x3],hl
ld hl,[p4_y3]
ld [p3_y3],hl
call sum3
ret c
ld [p4_sum123],hl
;234
push hl
ld hl,[p4_x2]
ld [p3_x1],hl
ld hl,[p4_y2]
ld [p3_y1],hl
ld hl,[p4_x3]
ld [p3_x2],hl
ld hl,[p4_y3]
ld [p3_y2],hl
ld hl,[p4_x4]
ld [p3_x3],hl
ld hl,[p4_y4]
ld [p3_y3],hl
call sum3
pop de
ret c
add hl,de
ret c
;341
push hl
ld hl,[p4_x3]
ld [p3_x1],hl
ld hl,[p4_y3]
ld [p3_y1],hl
ld hl,[p4_x4]
ld [p3_x2],hl
ld hl,[p4_y4]
ld [p3_y2],hl
ld hl,[p4_x1]
ld [p3_x3],hl
ld hl,[p4_y1]
ld [p3_y3],hl
call sum3
ld [p4_sum341],hl
pop de
ret c
add hl,de
ret c
;412
push hl
ld hl,[p4_x4]
ld [p3_x1],hl
ld hl,[p4_y4]
ld [p3_y1],hl
ld hl,[p4_x1]
ld [p3_x2],hl
ld hl,[p4_y1]
ld [p3_y2],hl
ld hl,[p4_x2]
ld [p3_x3],hl
ld hl,[p4_y2]
ld [p3_y3],hl
call sum3
pop de
ret c
add hl,de
ret c
ld de,[p4_sum42]
;cf=0
sbc hl,de
jp z,p4p100 ;△123+△234+△341+△412==2*□1234ならば、□1234は凸型である。

;凹型である場合
;1-4と2-3が自己交差していないか
ld hl,[p4_x1]
ld [cr_x1],hl
ld hl,[p4_y1]
ld [cr_y1],hl
ld hl,[p4_x4]
ld [cr_x2],hl
ld hl,[p4_y4]
ld [cr_y2],hl
ld hl,[p4_x2]
ld [cr_x3],hl
ld hl,[p4_y2]
ld [cr_y3],hl
ld hl,[p4_x3]
ld [cr_x4],hl
ld hl,[p4_y3]
ld [cr_y4],hl
call cross
jp c,p4p300
;自己交差1-4,2-3
ld a,1
ld [cr_flag],a
;1-2-5
ld hl,[p4_x1]
ld [p3_x1],hl
ld hl,[p4_y1]
ld [p3_y1],hl
ld hl,[p4_x2]
ld [p3_x2],hl
ld hl,[p4_y2]
ld [p3_y2],hl
ld hl,[cr_x5]
ld [p3_x3],hl
ld hl,[cr_y5]
ld [p3_y3],hl
call p3_polygon
ret c
;4-3-5
ld hl,[p4_x4]
ld [p3_x1],hl
ld hl,[p4_y4]
ld [p3_y1],hl
ld hl,[p4_x3]
ld [p3_x2],hl
ld hl,[p4_y3]
ld [p3_y2],hl
ld hl,[cr_x5]
ld [p3_x3],hl
ld hl,[cr_y5]
ld [p3_y3],hl
jp p3_polygon
p4p300:
;1-2と3-4が自己交差していないか
ld hl,[p4_x1]
ld [cr_x1],hl
ld hl,[p4_y1]
ld [cr_y1],hl
ld hl,[p4_x2]
ld [cr_x2],hl
ld hl,[p4_y2]
ld [cr_y2],hl
ld hl,[p4_x3]
ld [cr_x3],hl
ld hl,[p4_y3]
ld [cr_y3],hl
ld hl,[p4_x4]
ld [cr_x4],hl
ld hl,[p4_y4]
ld [cr_y4],hl
call cross
jp c,p4p310
;自己交差1-2,3-4
ld a,2
ld [cr_flag],a
;1-4-5
ld hl,[p4_x1]
ld [p3_x1],hl
ld hl,[p4_y1]
ld [p3_y1],hl
ld hl,[p4_x4]
ld [p3_x2],hl
ld hl,[p4_y4]
ld [p3_y2],hl
ld hl,[cr_x5]
ld [p3_x3],hl
ld hl,[cr_y5]
ld [p3_y3],hl
call p3_polygon
ret c
;2-3-5
ld hl,[p4_x2]
ld [p3_x1],hl
ld hl,[p4_y2]
ld [p3_y1],hl
ld hl,[p4_x3]
ld [p3_x2],hl
ld hl,[p4_y3]
ld [p3_y2],hl
ld hl,[cr_x5]
ld [p3_x3],hl
ld hl,[cr_y5]
ld [p3_y3],hl
jp p3_polygon
p4p310:
ld hl,[p4_sum123]
ld de,[p4_sum341]
add hl,de
ret c
ld de,[p4_sum4]
;cf=0
sbc hl,de
jr nz,p4p200
;△123+△341==□1234ならば、△123と△341に分けて描画する。
;123
ld hl,[p4_x1]
ld [p3_x1],hl
ld hl,[p4_y1]
ld [p3_y1],hl
ld hl,[p4_x2]
ld [p3_x2],hl
ld hl,[p4_y2]
ld [p3_y2],hl
ld hl,[p4_x3]
ld [p3_x3],hl
ld hl,[p4_y3]
ld [p3_y3],hl
call p3_polygon
ret c
;341
ld hl,[p4_x3]
ld [p3_x1],hl
ld hl,[p4_y3]
ld [p3_y1],hl
ld hl,[p4_x4]
ld [p3_x2],hl
ld hl,[p4_y4]
ld [p3_y2],hl
ld hl,[p4_x1]
ld [p3_x3],hl
ld hl,[p4_y1]
ld [p3_y3],hl
jp p3_polygon
p4p200:
;△123+△341!=□1234ならば、△234と△412に分けて描画する。
;234
ld hl,[p4_x2]
ld [p3_x1],hl
ld hl,[p4_y2]
ld [p3_y1],hl
ld hl,[p4_x3]
ld [p3_x2],hl
ld hl,[p4_y3]
ld [p3_y2],hl
ld hl,[p4_x4]
ld [p3_x3],hl
ld hl,[p4_y4]
ld [p3_y3],hl
call p3_polygon
ret c
;412
ld hl,[p4_x4]
ld [p3_x1],hl
ld hl,[p4_y4]
ld [p3_y1],hl
ld hl,[p4_x1]
ld [p3_x2],hl
ld hl,[p4_y1]
ld [p3_y2],hl
ld hl,[p4_x2]
ld [p3_x3],hl
ld hl,[p4_y2]
ld [p3_y3],hl
jp p3_polygon

p4p100: ;凸型である場合
ld hl,p4_x1
ld de,p4_minx
push hl
ldi
ldi
ldi
ldi
pop hl
ldi
ldi
ldi
ldi

;最大値、最小値を決める
ld hl,[p4_minx]
ld de,[p4_x2]
and a
sbc hl,de
bit 7,h
jr nz,p4p00
ld [p4_minx],de
p4p00:
ld hl,[p4_minx]
ld de,[p4_x3]
and a
sbc hl,de
bit 7,h
jr nz,p4p01
ld [p4_minx],de
p4p01:
ld hl,[p4_minx]
ld de,[p4_x4]
and a
sbc hl,de
bit 7,h
jr nz,p4p02
ld [p4_minx],de
p4p02:
ld hl,[p4_maxx]
ld de,[p4_x2]
and a
sbc hl,de
bit 7,h
jr z,p4p10
ld [p4_maxx],de
p4p10:
ld hl,[p4_maxx]
ld de,[p4_x3]
and a
sbc hl,de
bit 7,h
jr z,p4p11
ld [p4_maxx],de
p4p11:
ld hl,[p4_maxx]
ld de,[p4_x4]
and a
sbc hl,de
bit 7,h
jr z,p4p12
ld [p4_maxx],de
p4p12:
ld hl,[p4_miny]
ld de,[p4_y2]
and a
sbc hl,de
bit 7,h
jr nz,p4p20
ld [p4_miny],de
p4p20:
ld hl,[p4_miny]
ld de,[p4_y3]
and a
sbc hl,de
bit 7,h
jr nz,p4p21
ld [p4_miny],de
p4p21:
ld hl,[p4_miny]
ld de,[p4_y4]
and a
sbc hl,de
bit 7,h
jr nz,p4p22
ld [p4_miny],de
p4p22:
ld hl,[p4_maxy]
ld de,[p4_y2]
and a
sbc hl,de
bit 7,h
jr z,p4p30
ld [p4_maxy],de
p4p30:
ld hl,[p4_maxy]
ld de,[p4_y3]
and a
sbc hl,de
bit 7,h
jr z,p4p31
ld [p4_maxy],de
p4p31:
ld hl,[p4_maxy]
ld de,[p4_y4]
and a
sbc hl,de
bit 7,h
jr z,p4p32
ld [p4_maxy],de
p4p32:
;点や直線になるポリゴンは表示しない（後でポリゴンの境界にラインを引いて上書きするため）
ld hl,[p4_maxx]
ld de,[p4_minx]
and a
sbc hl,de
ret z ;cf=0
ld hl,[p4_maxy]
ld de,[p4_miny]
and a
sbc hl,de
ret z ;cf=0

ld a,[vvactive] ;仮想vramが使えるときは、内包判定を使用しないアルゴリズムを試す
and a
jr z,p4vv_polygon00
call p4vv_polygon
ret nc
p4vv_polygon00:

;描画
ld hl,[p4_miny]
p4p40:
ld [p3_y1],hl
ld de,200
and a
sbc hl,de
jr nc,p4p70

;minx -->
ld hl,[p4_minx]
p4p50:
ld [p3_x1],hl
ld de,[p4_maxx]
and a
sbc hl,de
jr z,p4p53
add hl,de
ld de,320
and a
sbc hl,de
jr nc,p4p51

call inner1234
ret c
jr z,p4p52
p4p51:
ld hl,[p3_x1]
inc hl
jr p4p50
p4p53:
call inner1234
ret c
jr nz,p4p70
p4p52:
ld hl,[p3_x1]
ld [dr_x1],hl

;<-- maxx
ld hl,[p4_maxx]
p4p60:
ld [p3_x1],hl
ld de,[dr_x1]
and a
sbc hl,de
jr z,p4p62
add hl,de
ld de,320
and a
sbc hl,de
jr nc,p4p61

call inner1234
ret c
jr z,p4p62
p4p61:
ld hl,[p3_x1]
dec hl
jr p4p60
p4p62:
ld hl,[p3_x1]
ld [dr_x2],hl
ld hl,[p3_y1]
ld [dr_y1],hl
ld [dr_y2],hl
call hline ;横１本を塗る
p4p70:
ld hl,[p3_y1]
inc hl
ld de,[p4_maxy]
and a
sbc hl,de
ret z ;cf=0
add hl,de
jr p4p40

inner1234: ;[p3_x1],[p3_y1]の[p4_x1〜4],[p4_y1〜4]の内包判定, cf=status, zf=1ならば内側にある
;p4の面積は[p4_sum4]に入れておく
;p12
ld hl,[p4_x1]
ld [p3_x2],hl
ld hl,[p4_y1]
ld [p3_y2],hl
ld hl,[p4_x2]
ld [p3_x3],hl
ld hl,[p4_y2]
ld [p3_y3],hl
call sum3
ret c
push hl
;p23
ld hl,[p4_x2]
ld [p3_x2],hl
ld hl,[p4_y2]
ld [p3_y2],hl
ld hl,[p4_x3]
ld [p3_x3],hl
ld hl,[p4_y3]
ld [p3_y3],hl
call sum3
pop de
ret c
add hl,de
ret c
push hl
;p34
ld hl,[p4_x3]
ld [p3_x2],hl
ld hl,[p4_y3]
ld [p3_y2],hl
ld hl,[p4_x4]
ld [p3_x3],hl
ld hl,[p4_y4]
ld [p3_y3],hl
call sum3
pop de
ret c
add hl,de
ret c
push hl
;p41
ld hl,[p4_x4]
ld [p3_x2],hl
ld hl,[p4_y4]
ld [p3_y2],hl
ld hl,[p4_x1]
ld [p3_x3],hl
ld hl,[p4_y1]
ld [p3_y3],hl
call sum3
pop de
ret c
add hl,de
ret c
ld de,[p4_sum4]
;cf=0
sbc hl,de ;□1234==△p12+p23+p34+p41で内側にある
ret

p3_line:
ld hl,[p30_x1]
ld [dr_x1],hl
ld hl,[p30_y1]
ld [dr_y1],hl
ld hl,[p30_x2]
ld [dr_x2],hl
ld hl,[p30_y2]
ld [dr_y2],hl
call line
ld hl,[p30_x2]
ld [dr_x1],hl
ld hl,[p30_y2]
ld [dr_y1],hl
ld hl,[p30_x3]
ld [dr_x2],hl
ld hl,[p30_y3]
ld [dr_y2],hl
call line
ld hl,[p30_x3]
ld [dr_x1],hl
ld hl,[p30_y3]
ld [dr_y1],hl
ld hl,[p30_x1]
ld [dr_x2],hl
ld hl,[p30_y1]
ld [dr_y2],hl
call line

ret

p4_line:
ld hl,[p40_x1]
ld [dr_x1],hl
ld hl,[p40_y1]
ld [dr_y1],hl
ld hl,[p40_x2]
ld [dr_x2],hl
ld hl,[p40_y2]
ld [dr_y2],hl
call line
ld hl,[p40_x2]
ld [dr_x1],hl
ld hl,[p40_y2]
ld [dr_y1],hl
ld hl,[p40_x3]
ld [dr_x2],hl
ld hl,[p40_y3]
ld [dr_y2],hl
call line
ld hl,[p40_x3]
ld [dr_x1],hl
ld hl,[p40_y3]
ld [dr_y1],hl
ld hl,[p40_x4]
ld [dr_x2],hl
ld hl,[p40_y4]
ld [dr_y2],hl
call line
ld hl,[p40_x4]
ld [dr_x1],hl
ld hl,[p40_y4]
ld [dr_y1],hl
ld hl,[p40_x1]
ld [dr_x2],hl
ld hl,[p40_y1]
ld [dr_y2],hl
call line

ret

p4_bline2: ;a=1 or 2, ポリゴンが自己交差した場合の輪郭表示
cp 1
jp nz,p4_bline21
;a=1 --> 1-2-5, 4-3-5
;1-2-5
ld hl,[p4_x1]
ld [dr_x1],hl
ld hl,[p4_y1]
ld [dr_y1],hl
ld hl,[p4_x2]
ld [dr_x2],hl
ld hl,[p4_y2]
ld [dr_y2],hl
call bline
ld hl,[p4_x2]
ld [dr_x1],hl
ld hl,[p4_y2]
ld [dr_y1],hl
ld hl,[cr_x5]
ld [dr_x2],hl
ld hl,[cr_y5]
ld [dr_y2],hl
call bline
ld hl,[p4_x1]
ld [dr_x1],hl
ld hl,[p4_y1]
ld [dr_y1],hl
ld hl,[cr_x5]
ld [dr_x2],hl
ld hl,[cr_y5]
ld [dr_y2],hl
call bline
;4-3-5
ld hl,[p4_x4]
ld [dr_x1],hl
ld hl,[p4_y4]
ld [dr_y1],hl
ld hl,[p4_x3]
ld [dr_x2],hl
ld hl,[p4_y3]
ld [dr_y2],hl
call bline
ld hl,[p4_x3]
ld [dr_x1],hl
ld hl,[p4_y3]
ld [dr_y1],hl
ld hl,[cr_x5]
ld [dr_x2],hl
ld hl,[cr_y5]
ld [dr_y2],hl
call bline
ld hl,[p4_x4]
ld [dr_x1],hl
ld hl,[p4_y4]
ld [dr_y1],hl
ld hl,[cr_x5]
ld [dr_x2],hl
ld hl,[cr_y5]
ld [dr_y2],hl
jp bline
p4_bline21:
;a=2 --> 1-4-5, 2-3-5
;1-4-5
ld hl,[p4_x1]
ld [dr_x1],hl
ld hl,[p4_y1]
ld [dr_y1],hl
ld hl,[p4_x4]
ld [dr_x2],hl
ld hl,[p4_y4]
ld [dr_y2],hl
call bline
ld hl,[p4_x4]
ld [dr_x1],hl
ld hl,[p4_y4]
ld [dr_y1],hl
ld hl,[cr_x5]
ld [dr_x2],hl
ld hl,[cr_y5]
ld [dr_y2],hl
call bline
ld hl,[p4_x1]
ld [dr_x1],hl
ld hl,[p4_y1]
ld [dr_y1],hl
ld hl,[cr_x5]
ld [dr_x2],hl
ld hl,[cr_y5]
ld [dr_y2],hl
call bline
;2-3-5
ld hl,[p4_x2]
ld [dr_x1],hl
ld hl,[p4_y2]
ld [dr_y1],hl
ld hl,[p4_x3]
ld [dr_x2],hl
ld hl,[p4_y3]
ld [dr_y2],hl
call bline
ld hl,[p4_x3]
ld [dr_x1],hl
ld hl,[p4_y3]
ld [dr_y1],hl
ld hl,[cr_x5]
ld [dr_x2],hl
ld hl,[cr_y5]
ld [dr_y2],hl
call bline
ld hl,[p4_x2]
ld [dr_x1],hl
ld hl,[p4_y2]
ld [dr_y1],hl
ld hl,[cr_x5]
ld [dr_x2],hl
ld hl,[cr_y5]
ld [dr_y2],hl
jp bline

p4_bline:
ld hl,[p4_x1]
ld [dr_x1],hl
ld hl,[p4_y1]
ld [dr_y1],hl
ld hl,[p4_x2]
ld [dr_x2],hl
ld hl,[p4_y2]
ld [dr_y2],hl
call bline
ld hl,[p4_x2]
ld [dr_x1],hl
ld hl,[p4_y2]
ld [dr_y1],hl
ld hl,[p4_x3]
ld [dr_x2],hl
ld hl,[p4_y3]
ld [dr_y2],hl
call bline
ld hl,[p4_x3]
ld [dr_x1],hl
ld hl,[p4_y3]
ld [dr_y1],hl
ld hl,[p4_x4]
ld [dr_x2],hl
ld hl,[p4_y4]
ld [dr_y2],hl
call bline
ld hl,[p4_x4]
ld [dr_x1],hl
ld hl,[p4_y4]
ld [dr_y1],hl
ld hl,[p4_x1]
ld [dr_x2],hl
ld hl,[p4_y1]
ld [dr_y2],hl
call bline

ret

hline_from: db 1+2+4+8+16+32+64+128
db 2+4+8+16+32+64+128
db 4+8+16+32+64+128
db 8+16+32+64+128
db 16+32+64+128
db 32+64+128
db 64+128
db 128

hline_to: db 1
db 1+2
db 1+2+4
db 1+2+4+8
db 1+2+4+8+16
db 1+2+4+8+16+32
db 1+2+4+8+16+32+64
db 1+2+4+8+16+32+64+128

hline: ;[dr_x1]-[dr_x2],[dr_y1] 横１本を塗る（ただしx1<=x2であること）
ld hl,[dr_y1]
ld de,200
and a
sbc hl,de
ret nc
add hl,de
ld d,h
ld e,l
add hl,hl ;*2
add hl,hl ;*4
add hl,de ;*5
add hl,hl ;*10
add hl,hl ;*20
add hl,hl ;*40
ld de,&e000 ;vram address
add hl,de

exx

ld hl,[dr_x2]
ld de,320
and a
sbc hl,de
ret nc
add hl,de

ld a,l ;to
and 7
ld c,a

srl h ;最大320/2
rr l
srl l ;最大160/2
srl l ;最大80/2

push hl
ld hl,[dr_x1]
ld de,320
and a
sbc hl,de
pop hl
ret nc
ld de,[dr_x1]

ld a,e ;from
and 7
ld b,a

srl d
rr e
srl e
srl e

ld a,l
sub e ;count

ex af,af'

push de

exx
pop de
add hl,de ;vram address (from)
exx

ld hl,hline_from
ld e,b ;from
add hl,de
ld b,[hl]

ld hl,hline_to
ld e,c ;to
add hl,de
ld c,[hl]

ex af,af'
jr nz,hline00
;同じアドレス上にfrom, toがある
ld a,b
and c
ex af,af'
exx

in a,[&e8] ;vramアクセス許可
set 7,a
res 6,a
out [&e8],a
ld a,&02
out [&f4],a

ex af,af'
or [hl]
ld [hl],a
jr hline100
hline00:
exx
ld b,a
exx
ld a,b ;from
ex af,af'
exx

in a,[&e8] ;vramアクセス許可
set 7,a
res 6,a
out [&e8],a
ld a,&02
out [&f4],a

ex af,af'
or [hl] ;from
ld [hl],a
jr hline10
hline11:
ld [hl],&ff
hline10:
inc hl
djnz hline11
exx
ld a,c ;to
exx
or [hl] ;to
ld [hl],a
;
hline100:
in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&03
out [&f4],a

ret

clsc: ;キャラクタvramをクリアする
in a,[&e8] ;vramアクセス許可
set 7,a
res 6,a
out [&e8],a

ld hl,&d000 ;vramクリア
ld de,&d000+1
ld bc,80*25-1
ld [hl],0
ldir

in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&03
out [&f4],a

ret

clsv: ;vramをクリアする
in a,[&e8] ;vramアクセス許可
set 7,a
res 6,a
out [&e8],a
ld a,&02
out [&f4],a

ld hl,&e000 ;vramクリア
ld de,&e000+1
ld bc,320*200/8-1
ld [hl],0
ldir

in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&03
out [&f4],a

ret

dr_x1: dw 0
dr_y1: dw 0
dr_x2: dw 0
dr_y2: dw 0
dr_dx: dw 0
dr_dy: dw 0
dr_s: dw 0
dr_spw: dw 0

pset: ;pset or preset(x1,y1): line/bline専用、他から呼び出さない
ld hl,[dr_y1]
ld bc,200
and a
sbc hl,bc
jr nc,pset10
ld hl,[dr_x1]
ld bc,320
and a
sbc hl,bc
jr c,pset00
pset10:
;(x1,y1)が範囲外
exx
bit 1,c
exx
ret z ;範囲外なので引き続きフェーズ=0を続ける
;フェーズ=1（範囲内）から範囲外へ移動したので終了する
ld sp,[dr_spw]
ret
pset00:
;(x1,y1)が範囲内
exx

bit 1,c
jr z,pset20 ;フェーズ0→1に移行する

;フェーズ1を続ける
ld a,b ;コード
dr_code11: ;&c6(set) or &86(res)
add a,&c6
ld [dr_code2+1],a
jr pset30

pset20: ;フェーズ=0→1に移行する最初のドット
set 1,c
exx
ld hl,[dr_y1]
ld b,h
ld c,l
add hl,hl ;*2
add hl,hl ;*4
add hl,bc ;*5
add hl,hl ;*10
add hl,hl ;*20
add hl,hl ;*40
dr_code3: ;&e000（実際のvram) or vvr（仮想vram）
ld bc,&e000 ;vram address
add hl,bc
ex de,hl

ld hl,[dr_x1]
ld a,l
and 7
add a,a
add a,a
add a,a
exx
ld b,a ;コード
exx
dr_code10: ;&c6(set) or &86(res)
add a,&c6
ld [dr_code2+1],a
srl h
rr l
srl h
rr l
srl h
rr l
add hl,de
push hl
exx
pop hl
pset30:
in a,[&e8] ;vramアクセス許可
set 7,a
res 6,a
out [&e8],a
ld a,&02
out [&f4],a

dr_code2: ;&c6+8*bit(set) or &86+8*bit(res)
set 0,[hl]

in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&03
out [&f4],a

exx

ret

line: ;line (dr_x1,dr_y1)-(dr_x2,dr_y2)
ld a,&c6 ;set
jr drawline

bline: ;bline (dr_x1,dr_y1)-(dr_x2,dr_y2)
ld a,&86 ;res
;
drawline:
ld [dr_spw],sp
ld [dr_code10+1],a
ld [dr_code11+1],a

ld c,0 ;フェーズ(bit1)=0
ld de,40
exx

;1000 *DRAWLINE
;1010 DX=ABS (X2-X1):DY=ABS (Y2-Y1)
ld hl,[dr_x1]
ld de,[dr_x2]
and a
sbc hl,de
bit 7,h
jr z,dr00
ex de,hl
xor a
ld h,a
ld l,a
sbc hl,de
dr00: ld [dr_dx],hl
ld hl,[dr_y1]
ld de,[dr_y2]
and a
sbc hl,de
bit 7,h
jr z,dr01
ex de,hl
xor a
ld h,a
ld l,a
sbc hl,de
dr01: ld [dr_dy],hl

;1020 10) IF DX>DY THEN
ld hl,[dr_dy] ;0>dy-dx
ld de,[dr_dx]
and a
sbc hl,de
bit 7,h
jr nz,dr10
jp dr1000
dr10:
;1030 20) IF X1>X2 THEN
ld hl,[dr_x2] ;0>x2-x1
ld de,[dr_x1]
and a
sbc hl,de
bit 7,h
jr nz,dr20
jp dr2000
dr20:
;1031 30) IF Y1>Y2 THEN ST=1 ELSE ST=-1
ld hl,[dr_y2] ;0>y2-y1
ld de,[dr_y1]
and a
sbc hl,de
bit 7,h
exx
jr z,dr3010
set 0,c ;c(bit0)=1のときst=1
jr dr3000
dr3010: res 0,c ;c(bit0)=0のときst=-1
dr3000: exx

;1032 S=X1:X1=X2:X2=S:Y1=Y2
ld hl,[dr_x1]
ld de,[dr_x2]
ld [dr_x1],de
ld [dr_x2],hl
ld hl,[dr_y2]
ld [dr_y1],hl

jp dr2010
;1040 20) ELSE
dr2000:
;1041 31) IF Y1<Y2 THEN ST=1 ELSE ST=-1
ld hl,[dr_y1] ;y1-y2<0
ld de,[dr_y2]
and a
sbc hl,de
bit 7,h
exx
jr z,dr3110
set 0,c ;c(bit0)=1のときst=1
jr dr3100
dr3110: res 0,c ;c(bit0)=0のときst=-1
dr3100: exx

;1050 20) ENDIF
dr2010:
;1060 X=X1:Y=Y1:GOSUB *DOT
call pset
;1070 S=INT (DX/2)
ld hl,[dr_dx]
srl h
rr l
ld [dr_s],hl
;1080 X1=X1+1
ld hl,[dr_x1]
inc hl
ld [dr_x1],hl

exx
ld a,b
add a,8
and 7*8
ld b,a
jr nz,drix01
inc hl
drix01: exx

;1090 32) WHILE X1<=X2
dr3200:
ld hl,[dr_x2] ;0<=x2-x1
ld de,[dr_x1]
and a
sbc hl,de
bit 7,h
jr nz,dr3210
;1091 S=S-DY
ld hl,[dr_s]
ld de,[dr_dy]
and a
sbc hl,de
ld [dr_s],hl
;1092 40) IF S<0 THEN S=S+DX:Y1=Y1+ST
bit 7,h
jr z,dr4000
ld de,[dr_dx]
add hl,de
ld [dr_s],hl
ld hl,[dr_y1]
exx
bit 0,c ;c(bit0)=1のときst=1
exx
jr nz,dr4010

dec hl
ld [dr_y1],hl

exx
and a
sbc hl,de
exx

jr dr4000
dr4010:
inc hl
ld [dr_y1],hl

exx
add hl,de
exx
dr4000:
;1093 X=X1:Y=Y1:GOSUB *DOT
call pset
;1094 X1=X1+1
ld hl,[dr_x1]
inc hl
ld [dr_x1],hl

exx
ld a,b
add a,8
and 7*8
ld b,a
jr nz,drix02
inc hl
drix02: exx

;1095 32) WEND
jr dr3200
dr3210:
jp dr1010
;1100 10) ELSE
dr1000:
;1110 20a) IF Y1>Y2 THEN
ld hl,[dr_y2] ;0>y2-y1
ld de,[dr_y1]
and a
sbc hl,de
bit 7,h
jr nz,dr20a
jp dr2000a
dr20a:
;1111 30a) IF X1>X2 THEN ST=1 ELSE ST=-1
ld hl,[dr_x2] ;0>x2-x1
ld de,[dr_x1]
and a
sbc hl,de
bit 7,h
exx
jr z,dr3010a
set 0,c ;c(bit0)=1のときst=1
jr dr3000a
dr3010a:res 0,c ;c(bit0)=0のときst=-1
dr3000a:exx

;1112 S=Y1:Y1=Y2:Y2=S:X1=X2
ld hl,[dr_y1]
ld de,[dr_y2]
ld [dr_y1],de
ld [dr_y2],hl
ld hl,[dr_x2]
ld [dr_x1],hl

jp dr2010a
;1120 20a) ELSE
dr2000a:
;1121 31a) IF X1<X2 THEN ST=1 ELSE ST=-1
ld hl,[dr_x1] ;x1-x2<0
ld de,[dr_x2]
and a
sbc hl,de
bit 7,h
exx
jr z,dr3110a
set 0,c ;c(bit0)=1のときst=1
jr dr3100a
dr3110a:res 0,c ;c(bit0)=0のときst=-1
dr3100a:exx

;1130 20a) ENDIF
dr2010a:
;1140 X=X1:Y=Y1:GOSUB *DOT
call pset
;1150 S=INT (DY/2)
ld hl,[dr_dy]
srl h
rr l
ld [dr_s],hl
;1160 Y1=Y1+1
ld hl,[dr_y1]
inc hl
ld [dr_y1],hl

exx
add hl,de
exx

;1170 32a) WHILE Y1<=Y2
dr3200a:
ld hl,[dr_y2] ;0<=y2-y1
ld de,[dr_y1]
and a
sbc hl,de
bit 7,h
jr nz,dr3210a
;1171 S=S-DX
ld hl,[dr_s]
ld de,[dr_dx]
and a
sbc hl,de
ld [dr_s],hl
;1172 40a) IF S<0 THEN S=S+DY:X1=X1+ST
bit 7,h
jr z,dr4000a
ld de,[dr_dy]
add hl,de
ld [dr_s],hl
ld hl,[dr_x1]
exx
bit 0,c ;c(bit0)=1のときst=1
exx
jr nz,dr4010a
dec hl
ld [dr_x1],hl

exx
ld a,b
sub 8
and 7*8
ld b,a
cp 7*8
jr nz,drdx01
dec hl
drdx01: exx

jr dr4000a
dr4010a:inc hl
ld [dr_x1],hl

exx
ld a,b
add a,8
and 7*8
ld b,a
jr nz,drix03
inc hl
drix03: exx

dr4000a:
;1173 X=X1:Y=Y1:GOSUB *DOT
call pset
;1174 Y1=Y1+1
ld hl,[dr_y1]
inc hl
ld [dr_y1],hl

exx
add hl,de
exx

;1175 32a) WEND
jr dr3200a
dr3210a:
;1180 10) ENDIF
dr1010:
;1190 RETURN
ret

ldcalddb: ;c=a, d=b
ld hl,floata
ld de,floatc
call mtom
ld hl,floatb
ld de,floatd
jp mtom

ldgaldhb: ;g=a, h=b
ld hl,floata
ld de,floatg
call mtom
ld hl,floatb
ld de,floath
jp mtom

ldpaldqb: ;p=a, q=b
ld hl,floata
ld de,floatp
call mtom
ld hl,floatb
ld de,floatq
jp mtom

ldagldbh: ;a=g, b=h
ld hl,floatg
ld de,floata
call mtom
ld hl,floath
ld de,floatb
jp mtom

addagaddbh: ;a=a+g, b=b+h
ld hl,floata
push hl
call mtox
ld hl,floatg
call mtox
call ad
jp c,err24
pop hl
call xtom

ld hl,floatb
push hl
call mtox
ld hl,floath
call mtox
call ad
jp c,err24
pop hl
jp xtom

;5050 "CHCS"G=A:H=B:GOSUB "CEXP":P=A:Q=B:A=-G:B=-H:GOSUB "CEXP":A=(P+A)/2:B=(Q+B)/2:RETURN
ncosh:
call ldgaldhb
call nexp
call ldpaldqb
call ldagldbh
call nchs
call nexp

ld hl,floatp
call mtox
ld hl,floata
push hl
call mtox
call ad
jp c,err24
pop hl
push hl
call xtom
pop hl
call fatn30 ;[hl]/2

ld hl,floatq
call mtox
ld hl,floatb
push hl
call mtox
call ad
jp c,err24
pop hl
push hl
call xtom
pop hl
jp fatn30 ;[hl]/2

;5060 "CHSN"G=A:H=B:GOSUB "CEXP":P=A:Q=B:A=-G:B=-H:GOSUB "CEXP":A=(P-A)/2:B=(Q-B)/2:RETURN
nsinh:
call ldgaldhb
call nexp
call ldpaldqb
call ldagldbh
call nchs
call nexp

ld hl,floatp
call mtox
ld hl,floata
push hl
call mtox
call sb
jp c,err25
pop hl
push hl
call xtom
pop hl
call fatn30 ;[hl]/2

ld hl,floatq
call mtox
ld hl,floatb
push hl
call mtox
call sb
jp c,err25
pop hl
push hl
call xtom
pop hl
jp fatn30 ;[hl]/2

mul2: ;[hl]=[hl]*2, cf=status
inc hl
ld a,[hl]
and a
ret z ;cf=0
inc a
scf
ret z ;cf=1
ld [hl],a
and a
ret ;cf=0

;5070 "CHTN"A=-2*A:B=-2*B:GOSUB "CEXP":
ntanh:
ld hl,floata
push hl
call mul2
jp c,err2
pop hl
call chs

ld hl,floatb
push hl
call mul2
jp c,err2
pop hl
call chs

call nexp

;C=1+A:D=B:A=1-A:B=-B:GOTO "C/"
ld hl,float1
call mtox
ld hl,floata
call mtox
call ad
jp c,err24
ld hl,floatc
call xtom

ld hl,floatb
ld de,floatd
call mtom

ld hl,float1
call mtox
ld hl,floata
push hl
call mtox
call sb
jp c,err25
pop hl
call xtom

ld hl,floatb
call chs

jp ndiv

;5080 "CAHC"G=A:H=B:C=A:D=B:CALL FMUL:A=A-1:GOSUB "CSQR":A=A+G:B=B+H:GOTO "CLN"
narccosh:
call ldgaldhb
call ldcalddb
call nmul
ld hl,floata
push hl
call mtox
ld hl,float1
call mtox
call sb
jp c,err25
pop hl
call xtom
call nsqr
call addagaddbh
jp nln

;5090 "CAHS"G=A:H=B:C=A:D=B:CALL FMUL:A=A+1:GOSUB "CSQR":A=A+G:B=B+H:GOTO "CLN"
narcsinh:
call ldgaldhb
call ldcalddb
call nmul
ld hl,floata
push hl
call mtox
ld hl,float1
call mtox
call ad
jp c,err24
pop hl
call xtom
call nsqr
call addagaddbh
jp nln

;5100 "CAHT"C=1-A:D=-B:
narctanh:
ld hl,float1
call mtox
ld hl,floata
call mtox
call sb
jp c,err25
ld hl,floatc
call xtom

ld hl,floatb
ld de,floatd
push de
call mtom
pop hl
call chs

;A=1+A:CALL FDIV:GOSUB "CLN":A=A/2:B=B/2:RETURN
ld hl,float1
call mtox
ld hl,floata
push hl
call mtox
call ad
jp c,err24
pop hl
call xtom

call ndiv
call nln

ld hl,floata
call fatn30 ;[hl]/2
ld hl,floatb
jp fatn30 ;[hl]/2

err27: ld a,27 ;error on cos
jp err

;5110 "CCOS"C=COS A*HCS B:
ncos:
ld hl,floata
call mtox
call cos
jr c,err27
ld hl,floatb
call mtox
call cosh
jr c,err27
call mul
jr c,err27
ld hl,floatc
call xtom

;B=-SIN A*HSN B:A=C:RETURN
ld hl,floata
call mtox
call sin
jr c,err27
ld hl,floatb
call mtox
call sinh
jr c,err27
call mul
jr c,err27
ld hl,floatb
push hl
call xtom
pop hl
call chs

ld hl,floatc
ld de,floata
jp mtom

err28: ld a,28 ;error on sin
jp err

;5120 "CSIN"C=SIN A*HCS B
nsin:
ld hl,floata
call mtox
call sin
jr c,err28
ld hl,floatb
call mtox
call cosh
jr c,err28
call mul
jr c,err28
ld hl,floatc
call xtom

;:B=COS A*HSN B:A=C:RETURN
ld hl,floata
call mtox
call cos
jr c,err28
ld hl,floatb
call mtox
call sinh
jr c,err28
call mul
jr c,err28
ld hl,floatb
call xtom

ld hl,floatc
ld de,floata
jp mtom

;5130 "CTAN"G=A:H=B:GOSUB "CCOS":P=A:Q=B:A=G:B=H:GOSUB "CSIN":C=P:D=Q:GOTO "C/"
ntan:
call ldgaldhb
call ncos
call ldpaldqb
call ldagldbh
call nsin
ld hl,floatp
ld de,floatc
call mtom
ld hl,floatq
ld de,floatd
call mtom
jp ndiv

;5140 "CATN"C=-A:D=1-B:B=1+B
narctan:
ld hl,floata
ld de,floatc
push de
call mtom
pop hl
call chs

ld hl,float1
call mtox
ld hl,floatb
call mtox
call sb
jp c,err25
ld hl,floatd
call xtom

ld hl,float1
call mtox
ld hl,floatb
call mtox
call ad
jp c,err24
ld hl,floatb
call xtom

;:CALL FDIV:GOSUB "CLN":C=-B/2:B=A/2:A=C:RETURN
call ndiv
call nln

ld hl,floatb
ld de,floatc
push de
call mtom
pop hl
push hl
call fatn30 ;[hl]/2
pop hl
call chs

ld hl,floata
ld de,floatb
push de
call mtom
pop hl
call fatn30 ;[hl]/2

ld hl,floatc
ld de,floata
jp mtom

;5150 "CASN"G=-B:H=A:C=A:D=B:CALL FMUL:A=1-A:B=-B:GOSUB "CSQR"
narcsin:
ld hl,floatb
ld de,floatg
push de
call mtom
pop hl
call chs
ld hl,floata
ld de,floath
call mtom
call ldcalddb
call nmul
call nchs
ld hl,float1
call mtox
ld hl,floata
push hl
call mtox
call ad
jp c,err24
pop hl
call xtom
call nsqr
;5151 A=A-G:B=B-H:GOSUB "CLN":C=-B:B=A:A=C:RETURN
ld hl,floatg
call chs
ld hl,floath
call chs
call addagaddbh
call nln
ld hl,floatb
ld de,floatc
push de
call mtom
pop hl
call chs
ld hl,floata
ld de,floatb
call mtom
ld hl,floatc
ld de,floata
jp mtom

;5160 "CACS"GOSUB "CASN":A=PI /2-A:B=-B:RETURN
narccos:
call narcsin
call nchs
ld hl,floatpidiv2
call mtox
ld hl,floata
push hl
call mtox
call ad
jp c,err24
pop hl
jp xtom

ncomma: ld hl,floatc
ld de,floata
call mtom
ld hl,floatd
ld de,floatb
jp mtom

nimage: ld hl,floatb
ld de,floata
call mtom
;
nreal: xor a
ld [floatb+1],a
ret

err26: ld a,26 ;not left value
jp err

nequal: ld a,[charformula_leftvalue]
and a
jr z,err26
call ncomma
dec a
ld c,a
ld b,0
add a,a ;*2
add a,c ;*3
add a,a ;*6
ld l,a
ld h,b
add hl,hl ;*12
ld de,complextmpatoz
add hl,de
ex de,hl
ld hl,floata
ld c,12
ldir
ret

float1div3: db &00,&7e,&ab,&aa,&aa,&aa ;1/3

npower: ;complex[a, b] ^= complex[c, d]
;5350 "C^"IF A=0THEN IF B=0THEN IF C>0THEN RETURN
ld a,[floata+1]
ld b,a
ld a,[floatb+1]
or b
jr nz,npower10

ld a,[floatc+1]
and a
jr z,err23
ld a,[floatc+0]
and a
ret z
npower10:
;5351 E=C:F=D:GOSUB "CLN":C=E:D=F:CALL FMUL:GOTO "CEXP"
ld hl,floatc
ld de,floate
call mtom
ld hl,floatd
ld de,floatf
call mtom
call nln
ld hl,floate
ld de,floatc
call mtom
ld hl,floatf
ld de,floatd
call mtom
call nmul
jp nexp

err23: ld a,23 ;error on power
jp err

nsqr: ld a,[floatb+1]
and a
jr nz,nsqr00
ld hl,floata
inc hl
ld a,[hl]
and a
ret z ;sqrt(0+0i)
dec hl
ld a,[hl]
add a,a
jr c,nsqr00

call mtox
call sqr
jr c,err23
ld hl,floata
jp xtom
nsqr00:
ld hl,float1div2
jr npowerfloat

ncur: ld hl,float1div3
;
npowerfloat: ;complex[a, b] ^= float[hl]
push hl

ld hl,floata
call is0
jr nz,npower00
ld hl,floatb
call is0
jr z,npower01
npower00:
call nln

ld hl,floata
call mtox
pop hl
push hl
call mtox
call mul
jr c,err23
ld hl,floata
call xtom

ld hl,floatb
call mtox
pop hl
call mtox
call mul
jr c,err23
ld hl,floatb
call xtom

call nexp

ret

npower01:
pop hl
ret

nln:
;5030 "CLN"
;5031 IF ABS A>=ABS B THEN
ld hl,floata
ld de,fnlna
push de
call mtom
pop de
push de
xor a
ld [de],a
ld hl,floatb
ld de,fnlnb
push de
call mtom
pop de
xor a
ld [de],a
pop hl
call fcp ;ABS B - ABS A
jr nc,nln00

;5032 C=ABS A*SQR (1+(B/A)^2)
ld hl,floatb
call mtox
ld hl,floata
call mtox
call div
jp c,err22
ld hl,fnlnc
push hl
push hl
call xtom
pop hl
push hl
call mtox
pop hl
call mtox
call mul
jp c,err22
pop hl
push hl
call mv1
pop hl
call mtox
call ad
jp c,err22
call sqr
jp c,err22
ld hl,fnlna
jr nln01
;5033 ELSE
nln00:
;5034 C=ABS B*SQR (1+(A/B)^2)
ld hl,floata
call mtox
ld hl,floatb
call mtox
call div
jp c,err22
ld hl,fnlnc
push hl
push hl
call xtom
pop hl
push hl
call mtox
pop hl
call mtox
call mul
jp c,err22
pop hl
push hl
call mv1
pop hl
call mtox
call ad
jp c,err22
call sqr
jp c,err22
ld hl,fnlnb
;5035 ENDIF
nln01:
call mtox
call mul
jp c,err22
ld hl,floatc
call xtom

;5036 D=(SGN B+1)*10+SGN A+1
ld hl,floata
push hl
call is0
pop hl
jr z,nln11
ld a,[hl]
and a
jr z,nln12
xor a ;A<0
jr nln13
nln11: ld a,1 ;A==0
jr nln13
nln12: ld a,2 ;A>0
nln13: ld b,a

ld hl,floatb
push hl
call is0
pop hl
jr z,nln21
ld a,[hl]
and a
jr z,nln22
xor a ;B<0
jr nln23
nln21: ld a,3 ;B==0
jr nln23
nln22: ld a,6 ;B>0
nln23:
add a,b
cp 3*1+0
jr z,nln5038
cp 3*1+1
jr z,nln5039
cp 3*1+2
jr z,nln5040
cp 3*2+0
jr z,nln5041
cp 3*2+1
jr z,nln5042
cp 3*2+2
jr z,nln5043
cp 3*0+0
jr z,nln5044
cp 3*0+1
jr z,nln5045
cp 3*0+2
jr z,nln5046

;5037 SWITCH D

nln5038: ;5038 CASE 10:B=PI
ld hl,floatpi
ld de,floatb
call mtom
jr nln5047

nln5039: ;5039 CASE 11:PRINT "LN 0"
jr err22

nln5040: ;5040 CASE 12:B=0
ld hl,floatb
call mv0
jr nln5047

nln5041: ;5041 CASE 20:B=PI +ATN (B/A)
call nln30
ld hl,floatpi
nln40: call mtox
call ad
jr c,err22
jr nln42

nln5042: ;5042 CASE 21:B=PI /2
ld hl,floatpidiv2
nln41: ld de,floatb
call mtom
jr nln5047

nln5046: ;5046 CASE 2:B=ATN (B/A)
nln5043: ;5043 CASE 22:B=ATN (B/A)
call nln30
nln42: ld hl,floatb
call xtom
jr nln5047

nln5044: ;5044 CASE 0:B=-PI +ATN (B/A)
call nln30
ld hl,floatmpi
jr nln40

nln5045: ;5045 CASE 1:B=-PI /2
ld hl,floatmpidiv2
jr nln41

;5047 ENDSWITCH
nln5047:
;5048 A=LN C:RETURN
ld hl,floatc
call mtox
call ln
jr c,err22
ld hl,floata
call xtom
ret

nln30: ld hl,floatb
ld de,acc1
call mtom
ld hl,floata
ld de,acc2
call mtom
call farctan
jr c,err22
ld hl,acc1
jp mtox

err22: ld a,22 ;error on ln
jp err

nexp:
;5020 "CEXP"IF B=0THEN A=EXP A:RETURN
ld hl,floatb
call is0
jr nz,nexp00
ld hl,floata
push hl
call mtox
call exp
jr c,err21
pop hl
call xtom
ret
nexp00:
;5021 F=EXP A:E=F*COS B:B=F*SIN B:A=E:RETURN
ld hl,floata
push hl
call mtox
call exp
jr c,err21
ld hl,floatf
push hl
call xtom
pop hl
push hl
call mtox
pop hl
call mtox
ld hl,floatb
push hl
push hl
call mtox
call cos
jr c,err21
call mul
jr c,err21
ld hl,floate
call xtom
pop hl
call mtox
call sin
jr c,err21
call mul
jr c,err21
pop hl
call xtom
ld hl,floate
pop de
call mtom
ret

err21: ld a,21 ;error on exp
jp err

err2: ld a,2 ;error on mul
jp err

nmul:
;E=A*C-B*D

ld hl,floata
call mtox
ld hl,floatc
call mtox
call mul
jr c,err2

ld hl,floatb
call mtox
ld hl,floatd
call mtox
call mul
jr c,err2

call sb
jr c,err2

;B=A*D+B*C:A=E

ld hl,floata
call mtox
ld hl,floatd
call mtox
call mul
jr c,err2

ld hl,floatb
call mtox
ld hl,floatc
call mtox
call mul
jr c,err2

call ad ;b=(y1)+(y0)
jr c,err2
ld hl,floatb
call xtom

ld hl,floata
call xtom

ret

err3: ld a,3 ;error on div
jp err

ndiv:
;F=C*C+D*D

ld hl,floatc
call mtox
ld hl,floatc
call mtox
call mul
jr c,err3

ld hl,floatd
call mtox
ld hl,floatd
call mtox
call mul
jr c,err3

call ad
jr c,err3
ld hl,floatf
call xtom

;E=(A*C+B*D)/F

ld hl,floata
call mtox
ld hl,floatc
call mtox
call mul
jr c,err3

ld hl,floatb
call mtox
ld hl,floatd
call mtox
call mul
jr c,err3

call ad
jr c,err3
ld hl,floatf
call mtox
call div
jr c,err3

;B=(B*C-A*D)/F:A=E

ld hl,floatb
call mtox
ld hl,floatc
call mtox
call mul
jr c,err3

ld hl,floata
call mtox
ld hl,floatd
call mtox
call mul
jp c,err3

call sb
jp c,err3

ld hl,floatf
call mtox
call div
jp c,err3
ld hl,floatb
call xtom

ld hl,floata
call xtom

ret

err24: ld a,24 ;error on add
jp err

nadd: ld hl,floata
call mtox
ld hl,floatc
call mtox
call ad
jr c,err24
ld hl,floata
call xtom

ld hl,floatb
call mtox
ld hl,floatd
call mtox
call ad
jr c,err24
ld hl,floatb
jp xtom

err25: ld a,25 ;error on sub
jp err

nsub: ld hl,floata
call mtox
ld hl,floatc
call mtox
call sb
jr c,err25
ld hl,floata
call xtom

ld hl,floatb
call mtox
ld hl,floatd
call mtox
call sb
jr c,err25
ld hl,floatb
jp xtom

mv0: ;[hl] = 0
inc hl
ld [hl],0
ret

mv1: ;[hl] = 1
push de
push bc
ex de,hl
ld hl,float1
mv100: call mtom
ex de,hl
pop bc
pop de
ret

mv0p5: ;[hl] = 0.5
push de
push bc
ex de,hl
ld hl,float1div2
jr mv100

nchs: ld hl,floata
call chs
ld hl,floatb
;
chs: ;[hl] = -[hl]
ld a,[hl]
xor 128
ld [hl],a
nnop: ret

mul: ;y*x -> x
call popacc12
call fmul
mtox100:push af
ld hl,acc1
call mtox
pop af
ret

div: ;y/x -> x
call popacc12
call fdiv
jr mtox100

ad: ;y+x -> x
call popacc12
call fadd
jr mtox100

sb: ;y-x -> x
call popacc12
call fsub
jr mtox100

sqr: ;sqr(x) -> x
call popacc1
call fsqrt
jr mtox100

exp: call popacc1
call fexp
jr mtox100

ln: call popacc1
call flog
jr mtox100

sin: call popacc1
call fsin
jr mtox100

cos: call popacc1
call fcos
jr mtox100

sinh: call popacc1
call fsinh
jr mtox100

cosh: call popacc1
call fcosh
jr mtox100

printcomplex: ;[ix~] = bcd complex [floata],[floatb]
ld hl,floata
ld de,acc1
call mtom

ld a,[floata+1]
ld b,a
ld a,[floatb+1]
ld c,a
or b
jp z,printbcdacc1 ;0+0i

inc b
dec b
jr z,printcmp00

push bc
call printbcdacc1
pop bc

inc c
dec c
ret z

printcmp00:
ld hl,floatb
ld de,acc1
call mtom
call printbcdacc1
ld [ix],'i'
inc ix
ret

getx: xor a
ld [charformula_leftvalue],a

call spcs

call inputbcdacc1
jr c,getx00

call spcs
ld hl,acc1
ld a,[ix]
cp 'i'
jr nz,getx01

inc ix
xor a
ld [floata+1],a
ld de,floatb
jp mtom
getx01:
xor a
ld [floatb+1],a
ld de,floata
jp mtom
getx00:
ld a,[ix]
call isoperator1
ld c,a
ld b,0
ld hl,ptroperator1
add hl,bc
add hl,bc
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
jp [hl]
getx10:
call getalphalength
dec b
jr nz,getx20

ld a,[ix]
sub 'a'
cp 26
jp nc,err1

inc ix

inc a
ld [charformula_leftvalue],a
dec a

ld c,a
add a,a ;*2
add a,c ;*3
add a,a ;*6
ld l,a
ld h,0
add hl,hl ;*12
ld bc,complextmpatoz
add hl,bc
ld de,floata
ld bc,12
ldir
ret
getx20:
inc b
call isstringoperator1
jp c,err1

push hl ;exp, ln などの処理アドレス

call getalphalength
push hl
pop ix

getx31: call getx

xor a
ld [charformula_leftvalue],a ;左辺値ではない

ret ;関数処理へ

getxnop: ;'+'
ld hl,nnop
jr getx30

getxnchs: ;'-'
ld hl,nchs
;
getx30: push hl
inc ix
jr getx31

getxparentheses: ;'('
call mtox16
inc ix
call getformula
call xtom16

call spcs
ld a,[ix]
cp ')'
jp nz,err1
inc ix

xor a
ld [charformula_leftvalue],a ;左辺値ではない

ret

getalphalength: ;[ix~]アルファベット文字の長さを調べる --> b=長さ, hl=次のアドレス
ld b,0
push ix
pop hl
geta00: ld a,[hl]
cp 'a'
ret c
cp 'z'+1
ret nc
inc hl
inc b
jr geta00

isstringoperator1: ;[ix~]=character, b=長さ --> 一致する文字列を探す
;hl=関数処理アドレス,cf=status
ld hl,stringoperator1
isst00: ld a,[hl]
and a
scf
ret z
cp b
jr nz,isst10

ex af,af'
push bc
push hl
exx
pop hl
pop bc
push ix
pop de
isst01: ld a,[de]
inc hl
cp [hl]
jr nz,isst02
inc de
djnz isst01
inc hl
ld a,[hl]
inc hl
ld h,[hl]
ld l,a
and a
ret ;cf=0

isst02: ex af,af'
exx

isst10: add a,1+2
ld e,a
ld d,0
add hl,de
jr isst00

isoperator1: ;a=character --> a=単項演算子コード
ld hl,charoperator1
ld b,charoperator1e-charoperator1
isop100:cp [hl]
jr z,isop110
inc hl
djnz isop100
isop110:
ld a,charoperator1e-charoperator1
sub b
ret

charoperator1:
db '+', '-', '('
charoperator1e:

ptroperator1:
dw getxnop, getxnchs, getxparentheses, getx10

stringoperator1:
db 3,'exp'
dw nexp
db 2,'ln'
dw nln
db 3,'sqr'
dw nsqr
db 4,'sqrt'
dw nsqr
db 3,'cur'
dw ncur
db 4,'cosh'
dw ncosh
db 4,'sinh'
dw nsinh
db 4,'tanh'
dw ntanh
db 7,'arccosh'
dw narccosh
db 7,'arcsinh'
dw narcsinh
db 7,'arctanh'
dw narctanh
db 3,'cos'
dw ncos
db 3,'sin'
dw nsin
db 3,'tan'
dw ntan
db 6,'arctan'
dw narctan
db 6,'arcsin'
dw narcsin
db 6,'arccos'
dw narccos
db 2,'re'
dw nreal
db 2,'im'
dw nimage
db 0

getformula: ;[ix~] = character --> [floata],[b] = complex number
ld a,255
ld [charformula_entrylevel],a
;
getformula00:
;bool getformula00(bool mustfindlabel, unsigned char entrylevel)
;{
; long x;
; unsigned char q;
;
; if(getx(mustfindlabel)) {return(TRUE);};
call getx
;
;lbl00:;
getf00:
;
; x=result;
ld hl,floata
ld de,floatformula_a
call mtom
ld hl,floatb
ld de,floatformula_b
call mtom
;
; spcs();
call spcs
;
; operator2[7]=*p;
; q=0;
; while(operator2[q]!=*p) {q++;};
ld a,[ix]
call isoperator2
;
; if(operator2priority[q]<entrylevel)
ld c,a
ld b,0
ld hl,charpriorityoperator2
add hl,bc
ld a,[charformula_entrylevel]
ld e,a
ld a,[hl]
cp e
ret nc
; {
; p++;
inc ix
;a=現在の priority level, bc=２項演算子番号
ld hl,ptroperator2
add hl,bc
add hl,bc
ld e,[hl]
inc hl
ld d,[hl]
ld [ptrformula_execaddress],de
call mtox16 ;a保存
ld [charformula_entrylevel],a
; if(getformula00(mustfindlabel, operator2priority[q])) {return(TRUE);};
call getformula00
; if(execoperator2(x, q)) {return(TRUE);}; //result=(x op2 result)
call xtom16
ld hl,floata
ld de,floatc
call mtom
ld hl,floatb
ld de,floatd
call mtom
ld hl,floatformula_a
ld de,floata
call mtom
ld hl,floatformula_b
ld de,floatb
call mtom
ld hl,getf01
push hl
ld hl,[ptrformula_execaddress]
jp [hl]
; goto lbl00;
getf01:
xor a
ld [charformula_leftvalue],a ;左辺値ではない

jr getf00
; }
; else
; {
; return(FALSE);
; };
;}
;
;bool getformula(bool mustfindlabel)
;{
; labelnotfound=FALSE;
;
; return(getformula00(mustfindlabel, 255));
;//エラーの時 TRUE を返す
;//エラー申告は関数最深部にて
;}

charoperator2:
db '+', '-', '*', '/', '^', '=', ','
charoperator2e:

ptroperator2:
dw nadd, nsub, nmul, ndiv, npower, nequal, ncomma

charpriorityoperator2:
db 3, 3, 2, 2, 1, 4, 5, 255

isoperator2: ;a=character --> a=２項演算子コード
ld hl,charoperator2
ld b,charoperator2e-charoperator2
isop200:cp [hl]
jr z,isop210
inc hl
djnz isop200
isop210:
ld a,charoperator2e-charoperator2
sub b
ret

spcs00: inc ix
spcs: ld a,[ix]
cp ' '
jr z,spcs00
ret

mtox16: ;stack push = [formulawork~]
ld hl,[ptrstackpointer]
ld bc,16
and a
sbc hl,bc
;cf=0
ld bc,floatstack
sbc hl,bc
jr c,err4
add hl,bc
ld [ptrstackpointer],hl
ld de,formulawork
ex de,hl
;
mtom16: ;[de~] = [hl~]
ld bc,16
ldir
ret

xtom16: ;[formulawork~] = stack pop
ld hl,[ptrstackpointer]
ld bc,floatstacktop
and a
sbc hl,bc
jr nc,err4 ;スタックが空である
add hl,bc
ld de,formulawork
call mtom16
ld [ptrstackpointer],hl
ret

mtox: ;float stack push = float [hl]
ex de,hl
ld hl,[ptrstackpointer]
ld bc,6
and a
sbc hl,bc
;cf=0
ld bc,floatstack
sbc hl,bc
jr c,err4
add hl,bc
ld [ptrstackpointer],hl
ex de,hl
;
mtom: ;float [de] = float [hl]
ld bc,6
ldir
ret

mctomc: ;complex [de] = complex [hl]
ld bc,12
ldir
ret

popacc12:
ld hl,acc2
call xtom
;
popacc1:ld hl,acc1
;
xtom: ;float [hl] = float stack pop
ex de,hl
ld hl,[ptrstackpointer]
ld bc,floatstacktop
and a
sbc hl,bc
jr nc,err4 ;スタックが空である
add hl,bc
call mtom
ld [ptrstackpointer],hl
ret

err1: ld a,1 ;syntax error
jr err

err29: ld a,29 ;unknown error
jr err

err4: ld a,4 ;stack over flow
;
err: ld b,a
ld hl,errmsg
jr errchk00

errchk01:
ld a,[hl]
and a
jr z,err29 ;定義されていないエラー

push bc
ld bc,0
ld a,13
cpir
pop bc

errchk00:
djnz errchk01

call message
call crlf

jp main

errmsg: db 'syntax/value input error',13 ;1
db 'error on mul',13 ;2
db 'error on div',13 ;3
db 'stack over flow',13 ;4
db 'over flow',13 ;5 +++++++
db 'out of memory',13 ;6 +++++++
db 13 ;7
db 13 ;8
db 13 ;9
db 13 ;10
db 13 ;11
db 13 ;12
db 13 ;13
db 13 ;14
db 13 ;15
db 13 ;16
db 13 ;17
db 13 ;18
db 13 ;19
db 13 ;20
db 'error on exp',13 ;21
db 'error on ln',13 ;22
db 'error on power',13 ;23
db 'error on add',13 ;24
db 'error on sub',13 ;25
db 'not left value',13 ;26
db 'error on cos',13 ;27
db 'error on sin',13 ;28
db 'unknown error',13 ;29
db 0

floatsqrt2: db &00,&80,&33,&f3,&04,&b5 ;sqrt(2)

fsqrt: ;acc1=sqrt(acc1), cf=status
ld hl,acc1
push hl
call is0
pop hl
ret z ;cf=0
bit 7,[hl]
scf
ret nz ;acc1<0

inc hl
ld a,[hl] ;指数部
ld [charwork00],a
ld [hl],128 ;1<=acc1<2とする

;6040 Y0=Y:Y=1+(Y-1)/2 ；SQR Yの概略の近似値を出しておく
ld hl,acc1
ld de,acc3
ld bc,6
ldir

ld hl,float1
ld de,acc2
ld c,6
ldir
call fsub
ret c

ld hl,acc1
call fatn30

ld hl,float1
ld de,acc2
ld bc,6
ldir
call fadd
ret c

;6050 K=1
ld b,8

fsqr00: push bc

;6051 Y1=Y:Y=(Y0/Y+Y)/2:IF Y1<>Y THEN K=K+1:GOTO 6051；平方根を求めるループ
ld hl,acc1
push hl
push hl
ld de,acc4
ld bc,6
ldir
pop hl
ld de,acc2
ld c,6
ldir
ld hl,acc3
pop de
ld c,6
ldir
call fdiv
jr c,fsqrerr

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fadd
jr c,fsqrerr

ld hl,acc1
call fatn30

ld hl,acc4
ld de,acc1
call fcp

pop bc

jr z,fsqr10

djnz fsqr00

;++++
ld a,'R'
call pcha
call space

jr fsqr10

fsqrerr:pop bc
scf
ret

fsqr10: ld a,[charwork00]
sub 128
sra a
push af
add a,128
ld [acc1+1],a
pop af
ret nc

ld hl,floatsqrt2
ld de,acc2
ld bc,6
ldir

jp fmul

float1div2: db &00,&7f,&00,&00,&00,&80 ;1/2

farctan: ;acc1=arctan(acc1/acc2), cf=status
ld hl,acc1+0
ld a,[hl]
ld [hl],0
ld hl,acc2+0
ld b,[hl]
ld [hl],0
xor b
ld [charwork00],a

ld de,acc2
ld hl,acc1
call fcp
jr c,fatn00

call fdiv
ret c

call fatn10
ret c
jr fatn02
fatn00:
ld hl,acc1
ld de,acc2
ld b,6
fatn01: ld c,[hl]
ld a,[de]
ex de,hl
ld [hl],c
ld [de],a
ex de,hl
inc hl
inc de
djnz fatn01

call fdiv
ret c

call fatn10
ret c

ld hl,floatpidiv2
ld de,acc2
ld bc,6
ldir
ld hl,acc1+0
ld a,[hl]
xor 128
ld [hl],a
call fadd
ret c
fatn02:
ld a,[charwork00]
ld hl,acc1+0
xor [hl]
ld [hl],a
and a
ret ;cf=0

floatfatn0to1div2:
db &00,&7b,&a4,&81,&94,&9d ;x^6
db &80,&7c,&27,&5b,&2c,&a3 ;x^5
db &00,&7c,&fc,&2a,&fd,&df ;x^4
db &80,&7d,&09,&43,&24,&92 ;x^3
db &00,&7d,&22,&69,&cb,&cc ;x^2
db &80,&7e,&6b,&a8,&aa,&aa ;x^1
db &00,&80,&00,&00,&00,&80 ;1

floatfatn1div2to1:
db &80,&7c,&e9,&b8,&13,&8e ;x^5
db &00,&7c,&aa,&a2,&6a,&de ;x^4
db &80,&7d,&3f,&4f,&25,&92 ;x^3
db &00,&7d,&3d,&f0,&cb,&cc ;x^2
db &80,&7e,&ce,&a9,&aa,&aa ;x^1
db &00,&80,&00,&00,&00,&80 ;1

floatarctan1div2:
db &00,&7e,&2b,&38,&63,&ed ;arctan(1/2)

fatn10: ;acc1=arctan(acc1)ただし0<=acc1<=1,cf=status
ld de,float1div2
ld hl,acc1
call fcp
jr c,fatn20

;acc1 <= 1/2
ld hl,acc1
push hl
ld de,acc4
ld bc,6
ldir
pop hl
ld de,acc2
ld c,6
ldir
call fmul
ret c

ld hl,floatfatn0to1div2
ld b,7
call fpolynomial
ret c

ld hl,acc4
ld de,acc2
ld bc,6
ldir
jp fmul

fatn20: ;acc1 > 1/2
;(acc1 - 1/2)/(1 + acc1/2)
ld hl,acc1
push hl
ld de,acc3
ld bc,6
ldir
pop hl
call fatn30
ld hl,float1
ld de,acc2
ld bc,6
ldir
call fadd
ret c
ld hl,acc1
ld de,acc4
ld bc,6
ldir

ld hl,acc3
ld de,acc1
ld bc,6
ldir
ld hl,float1div2
ld de,acc2
ld c,6
ldir
call fsub
ret c

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fdiv
ret c

ld hl,acc1
push hl
ld de,acc4
ld bc,6
ldir
pop hl
ld de,acc2
ld c,6
ldir
call fmul
ret c

ld hl,floatfatn1div2to1
ld b,6
call fpolynomial
ret c

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fmul
ret c

ld hl,floatarctan1div2
ld de,acc2
ld bc,6
ldir

jp fadd

fatn30: ;[hl]/2
inc hl
ld a,[hl]
and a
ret z
dec a
ld [hl],a
ret

floatpidiv2: db &00,&80,&a3,&da,&0f,&c9 ;pi/2
floatmpidiv2: db &80,&80,&a3,&da,&0f,&c9 ;-pi/2

floatpi: db &00,&81,&a3,&da,&0f,&c9 ;pi
floatmpi: db &80,&81,&a3,&da,&0f,&c9 ;-pi

floatfsin:
db &80,&66,&04,&5b,&36,&cd ;x^5
db &00,&6d,&2e,&8e,&b8,&b8 ;x^4
db &80,&73,&22,&f1,&0b,&d0 ;x^3
db &00,&79,&39,&86,&88,&88 ;x^2
db &80,&7d,&a5,&aa,&aa,&aa ;x^1
db &00,&80,&00,&00,&00,&80 ;1

floatfcos:
db &00,&63,&15,&5a,&ce,&88 ;x^6
db &80,&6a,&83,&de,&c5,&93 ;x^5
db &00,&70,&85,&d9,&0b,&d0 ;x^4
db &80,&76,&d9,&5c,&0b,&b6 ;x^3
db &00,&7b,&9f,&aa,&aa,&aa ;x^2
db &80,&7f,&00,&00,&00,&80 ;x^1
db &00,&80,&00,&00,&00,&80 ;1

fcos: ;acc1=cos(acc1), cf=status
ld hl,floatpidiv2
ld de,acc2
ld bc,6
ldir
call fadd
ret c
;
fsin: ;acc1=sin(acc1), cf=status
ld hl,acc1+0
ld a,[hl]
ld [charwork00],a
ld [hl],0

ld b,16
fsin00: push bc

ld de,floatpi
ld hl,acc1
call fcp
jr nc,fsin10

ld hl,floatpi
ld de,acc2
ld bc,6
ldir
call fsub

pop bc
ret c
djnz fsin00
scf
ret

fsin10: pop af
ld [charwork01],a

ld de,floatpidiv2
ld hl,acc1
call fcp
jr c,fsin20

;acc1 <= pi/2

ld hl,acc1
push hl
ld de,acc4
ld bc,6
ldir
pop hl
ld de,acc2
ld c,6
ldir
call fmul
ret c

ld hl,floatfsin
ld b,6
call fpolynomial
ret c

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fmul
ret c

jr fsin30

fsin20: ;acc1 > pi/2
ld hl,floatpidiv2
ld de,acc2
ld bc,6
ldir
call fsub
ret c

ld hl,acc1
ld de,acc2
ld bc,6
ldir
call fmul
ret c

ld hl,floatfcos
ld b,7
call fpolynomial
ret c
;
fsin30: ld a,[charwork01]
rrca
and 128
ld b,a
ld a,[charwork00]
xor b
ld [acc1+0],a
and a
ret ;cf=0

inputbcdacc1: ;[ix~]=character --> acc1=number, cf=status
;cf=0のとき、正常終了、ix=next address
;cf=1のとき、エラー終了、ix=保存
;[acc5]=小数点以上の合計
;[acc6]=小数点以下の合計
;[acc7]=10, 100, 1000, 10000, ...
;[acc8]=10のべき乗

ld [intwork00],ix

ld hl,float1
ld de,acc8
ld bc,6
ldir

xor a
ld [acc5+1],a
ld [acc6+1],a

ld a,[ix]
cp '.'
jp z,inba10

call isnumber
ret c

inba00: push af
ld hl,acc5
ld de,acc1
ld bc,6
ldir
ld hl,float10
ld de,acc2
ld c,6
ldir
call fmul
ld hl,acc1
ld de,acc2
ld bc,6
ldir
pop bc
jr c,inbaerr
ld a,b
call itof
call fadd
jr c,inbaerr
ld hl,acc1
ld de,acc5
ld bc,6
ldir

inc ix
ld a,[ix]
cp '.'
jr z,inba10
cp 'e'
jp z,inba20

call isnumber
jr nc,inba00
;
inbaend:ld hl,acc5
ld de,acc1
ld bc,6
ldir
ld hl,acc6
ld de,acc2
ld c,6
ldir
call fadd
jr c,inbaerr
ld hl,acc8
ld de,acc2
ld bc,6
ldir
call fmul
ret nc
;
inbaerr:ld ix,[intwork00]
scf
ret

inba10: ;[ix]='.'
ld hl,float10
ld de,acc7
ld bc,6
ldir

inba11: inc ix
ld a,[ix]
cp 'e'
jr z,inba20

call isnumber
jr c,inbaend

call itof
ld hl,acc7
ld de,acc2
ld bc,6
ldir
call fdiv
jr c,inbaerr
ld hl,acc6
ld de,acc2
ld bc,6
ldir
call fadd
jr c,inbaerr

ld hl,acc1
ld de,acc6
ld bc,6
ldir

ld hl,acc7
ld de,acc1
ld c,6
ldir

ld hl,float10
ld de,acc2
ld c,6
ldir

call fmul
jr c,inbaerr

ld hl,acc1
ld de,acc7
ld bc,6
ldir

jr inba11

inba20: ;[ix]='e'
inc ix
ld a,[ix]
cp '+'
jr z,inba21
cp '-'
jr z,inba21
call isnumber
jp c,inbaerr
ld a,'+'
dec ix
inba21: inc ix
ex af,af'
call inba30
jp c,inbaerr
ex af,af'
cp '+'
jr z,inba22
ld a,b
neg
ld b,a
inba22: ld a,b
call itof
call fexp10
jp c,inbaerr
ld hl,acc1
ld de,acc8
ld bc,6
ldir
jp inbaend

inba30: ld b,0
ld a,[ix]
call isnumber
ret c
inba31: ld c,a
ld a,b
add a,a
ret c
add a,a
ret c
add a,b
ret c
add a,a
ret c
add a,c
ret c
cp 100
ccf
ret c
ld b,a
inc ix
ld a,[ix]
call isnumber
jr nc,inba31
and a
ret ;cf=0

isnumber: ;a=character --> 数字のとき cf=0, a=数、数字でないとき cf=1
sub '0'
ret c
cp 10
ccf
ret

float10:db &00,&83,&00,&00,&00,&a0 ;10

printbcdacc1: ;[ix~]=bcd acc1
ld hl,[acc1+0]
ld a,h
and a
jr nz,prba00

ld [ix],'0'
inc ix
ret
prba00:
ld a,l
ld [charwork00],a
xor a
ld [acc1+0],a

ld hl,acc1
ld de,acc5
ld bc,6
ldir

ld iy,charwork02

call flog10
call ftoi
bit 7,c
jr z,prba13
neg
prba13:
ld [iy],a
call itof
call fexp10

ld hl,acc1
ld de,acc2
ld bc,6
ldir
ld hl,acc5
ld de,acc1
ld c,6
ldir
call fdiv
prba10:
ld de,acc1
ld hl,float1
call fcp
jr nc,prba11
;acc1<1
ld hl,float10
ld de,acc2
ld bc,6
ldir
call fmul
dec [iy]
jr prba10
prba11:
ld de,acc1
ld hl,float10
call fcp
jr c,prba12
;acc1>=10
ld hl,float10
ld de,acc2
ld bc,6
ldir
call fdiv
inc [iy]
jr prba10
prba12:
ld iy,charwork01

call ftoi
ld [iy],a
inc iy

ld b,8
prba20:
push bc

ld hl,acc1
ld de,acc2
ld bc,6
ldir
call itof
ld a,128
ld [acc1+0],a
call fadd
ld hl,acc1
ld de,acc2
ld bc,6
ldir
ld a,10
call itof
call fmul
call ftoi
ld [iy],a
inc iy

pop bc
djnz prba20

ld hl,charwork00
ld a,[hl]
and a
ld a,'+'
jr z,prba30
ld a,'-'
prba30: ld [ix],a
inc ix

ld hl,charwork01+8
ld a,[hl]
ld [hl],0
cp 5
jr c,prba31
ld b,8
prba32:
ld [hl],0
dec hl
inc [hl]
ld a,[hl]
cp 10
jr c,prba31
djnz prba32

ld [hl],1
ld hl,charwork02
inc [hl]
prba31:
ld hl,charwork01
ld a,[charwork02]
ld c,a
ld b,8
and a
jp m,prba33
cp 8
jr nc,prba40

;xxxx.yyyy
inc c
prba60:
ld a,[hl]
inc hl
add a,'0'
ld [ix],a
inc ix
dec b
dec c
jr nz,prba60

inc b
dec b
ret z

call prba70
ret z

ld [ix],'.'
inc ix
prba61:
ld a,[hl]
inc hl
add a,'0'
ld [ix],a
inc ix
call prba70
ret z
djnz prba61
ret

prba33: cp -3
jr c,prba40
;
prba50: ;0.000xxxx
ld [ix],'0'
inc ix
ld [ix],'.'
inc ix
jr prba51
prba52:
ld [ix],'0'
inc ix
prba51: inc c
jr nz,prba52
jr prba61

prba40: ;x.yyyyyezz
ld a,[hl]
inc hl
add a,'0'
ld [ix],a
inc ix

ld b,7

call prba70
jr z,prba42

ld [ix],'.'
inc ix
prba41:
ld a,[hl]
inc hl
add a,'0'
ld [ix],a
inc ix
call prba70
jr z,prba42
djnz prba41
prba42:
ld [ix],'e'
inc ix
ld a,[charwork02]
ld b,a
jp printbcdb

prba70: push bc
push hl
prba71: ld a,[hl]
inc hl
and a
jr nz,prba72
djnz prba71
prba72: pop hl
pop bc
ret

fcp: ;[de] - [hl] --> zf,cf=status
push de
ld de,ftmpx ;[ftmpx]=[hl]
ld bc,6
ldir
pop hl
ld de,ftmpy ;[ftmpy]=[de]
ld c,6
ldir

ld hl,ftmpy
push hl
call is0
pop hl
jr z,cp00
ld a,[hl]
and a
jr z,cp01
ld b,0 ;[y]<0
jr cp02
cp00: ld b,1 ;[y]==0
jr cp02
cp01: ld b,2 ;[y]>0
cp02:
ld hl,ftmpx
push hl
call is0
pop hl
jr z,cp10
ld a,[hl]
and a
jr z,cp11
ld a,0 ;[x]<0
jr cp12
cp10: ld a,3 ;[x]==0
jr cp12
cp11: ld a,6 ;[x]>0
cp12:
add a,b
jr z,xlt0ylt0
dec a
jr z,xlt0yeq0
dec a
jr z,xlt0ygt0
dec a
jr z,xeq0ylt0
dec a
jr z,xeq0yeq0
dec a
jr z,xeq0ygt0
dec a
jr z,xgt0ylt0
dec a
jr z,xgt0yeq0
dec a
jr z,xgt0ygt0

xlt0ylt0: ;(-) - (-)
call xgt0ygt0
ret z
jr c,cp21
scf
ret
cp21: ld a,1
and a
ret ;zf=0, cf=0

xlt0yeq0: ;(0) - (-)
xlt0ygt0: ;(+) - (-)
xeq0ygt0: ;(+) - (0)
ld a,1
sub 0
ret

xeq0ylt0: ;(-) - (0)
xgt0ylt0: ;(-) - (+)
xgt0yeq0: ;(0) - (+)
ld a,0
sub 1
ret

xeq0yeq0: ;(0) - (0)
sub a
ret

xgt0ygt0: ;(+) - (+)
ld de,ftmpy+1
ld hl,ftmpx+1
ld a,[de]
cp [hl]
ret nz
ld de,ftmpy+5
ld hl,ftmpx+5
ld b,4
xgt0ygt000:
ld a,[de]
dec de
cp [hl]
dec hl
ret nz
djnz xgt0ygt000
ret

floatflog2:
db &00,&7e,&18,&2d,&73,&b4 ;x^5
db &00,&7e,&ff,&2c,&0b,&9e ;x^4
db &00,&7e,&45,&ad,&66,&d3 ;x^3
db &00,&7f,&e8,&3d,&ba,&93 ;x^2
db &00,&7f,&42,&51,&38,&f6 ;x^1
db &00,&81,&29,&3b,&aa,&b8 ;x^0

float2: db &00,&81,&00,&00,&00,&80 ;2

floatlog2divlog10:
db &00,&7e,&85,&9a,&20,&9a ;log 2 / log 10

floatlog2:
db &00,&7f,&f8,&17,&72,&b1 ;log 2

flog: ;acc1=x --> acc1=log(x), cf=status
call flog2
ret c
ld hl,floatlog2
ld de,acc2
ld bc,6
ldir
jp fmul

flog10: ;acc1=x --> acc1=log10(x), cf=status
call flog2
ret c
ld hl,floatlog2divlog10
ld de,acc2
ld bc,6
ldir
jp fmul

flog2: ;acc1=x --> acc1=log2(x), cf=status
ld hl,[acc1+0]
ld a,h
and a
scf
ret z
bit 7,l
scf
ret nz

sub 128
push af

ld a,128
ld [acc1+1],a
ld hl,float1
ld de,acc2
ld bc,6
ldir
call fsub
jr c,flog2e

;acc4 = acc1/(2 + acc1)
ld hl,acc1
ld de,acc3
ld bc,6
ldir
ld hl,float2
ld de,acc2
ld c,6
ldir
call fadd
jr c,flog2e
ld hl,acc1
ld de,acc2
ld bc,6
ldir
ld hl,acc3
ld de,acc1
ld c,6
ldir
call fdiv
jr c,flog2e
ld hl,acc1
push hl
ld de,acc4
ld bc,6
ldir
;acc1=acc4^2
pop hl
ld de,acc2
ld c,6
ldir
call fmul
jr c,flog2e

ld hl,floatflog2
ld b,6
call fpolynomial
jr c,flog2e

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fmul
jr c,flog2e

ld hl,acc1
ld de,acc2
ld bc,6
ldir

pop af

call itof

jp fadd

flog2e: pop bc
scf
ret

fsinh: ;acc1=x --> acc1=sinh(x), cf=status ==(exp(x) - exp(-x))/2
call fexp
jp c,err21
ld hl,acc1
ld de,acc3
call mtom ;acc3=exp(x)
call frcp ;acc1=exp(-x)
jp c,err3

ld hl,acc1
call chs

fsinh00:ld hl,acc3
ld de,acc2
call mtom

call fadd
jp c,err24

ld hl,acc1
call fatn30 ;[hl]/2
and a
ret ;cf=0

fcosh: ;acc1=x --> acc1=cosh(x), cf=status ==(exp(x) + exp(-x))/2
call fexp
jp c,err21
ld hl,acc1
ld de,acc3
call mtom ;acc3=exp(x)
call frcp ;acc1=exp(-x)
jr nc,fsinh00
jp err3

floatfexp2:
db &00,&70,&a1,&b5,&b8,&b5 ;x^7
db &00,&73,&33,&21,&f0,&95 ;x^6
db &00,&76,&a0,&08,&05,&b0 ;x^5
db &00,&79,&e5,&78,&82,&9d ;x^4
db &00,&7b,&38,&75,&59,&e3 ;x^3
db &00,&7d,&09,&e7,&fd,&f5 ;x^2
db &00,&7f,&0e,&18,&72,&b1 ;x^1
float1: db &00,&80,&00,&00,&00,&80 ;1

floatlog10divlog2:
db &00,&81,&4b,&78,&9a,&d4 ;log 10 / log 2

float1divlog2:
db &00,&80,&29,&3b,&aa,&b8 ;1 / log(2)

fexp: ;acc1=x --> acc1=e^x, cf=status
ld hl,float1divlog2
ld de,acc2
ld bc,6
ldir
call fmul
ret c
jr fexp2

fexp10: ;acc1=x --> acc1=10^x, cf=status
ld hl,floatlog10divlog2
ld de,acc2
ld bc,6
ldir
call fmul
ret c
;
fexp2: ;acc1=x --> acc1=2^x, cf=status
ld a,[acc1+0]
add a,a
jr nc,fexp200

call ftoi
jr c,fexp210 ;2^LT(-127)

xor a
ld [acc1+0],a
call fexp200
ret c
ld hl,acc1
ld de,acc2
ld bc,6
ldir
ld hl,float1
ld de,acc1
ld c,6
ldir
jp fdiv

fexp210:xor a
ld [acc1+1],a
ret ;cf=0

fexp200:call ftoi
ret c
push af
ld hl,acc1
ld de,acc2
ld bc,6
ldir
call itof
ld a,128
ld [acc1+0],a
call fadd
pop bc
ret c
push bc
ld hl,floatfexp2
ld b,8
call fpolynomial
pop bc
ret c
ld a,[acc1+1]
and a
ret z ;cf=0
add a,b
ld [acc1+1],a
ret ;cf=status

fpolynomial: ;acc1=x, hl=ptr constant, b=count --> acc1=polynomial, cf=status
exx
ld hl,acc1
ld de,acc3
ld bc,6
ldir
exx
push bc
ld de,acc2
ld bc,6
ldir
push hl
call fmul
pop hl
pop bc
ret c

djnz fpoly00

ret ;cf=0

fpoly01:
exx
ld hl,acc3
ld de,acc2
ld bc,6
ldir
exx
push bc
push hl
call fmul
pop hl
pop bc
ret c
fpoly00:
push bc
ld de,acc2
ld bc,6
ldir
push hl
call fadd
pop hl
pop bc
ret c

djnz fpoly01

ret ;cf=0

printbcdb: ;[ix~] = bcd b
inc b
dec b
jr nz,pbcdb00

ld [ix],'0'
inc ix
ret
pbcdb00:
bit 7,b
ld a,'+'
jr z,pbcdb10
ld a,b
neg
ld b,a
ld a,'-'
pbcdb10:
ld [ix],a
inc ix

ld c,0
ld a,b

ld b,100
call pbcdb20
ld b,10
call pbcdb20
add a,'0'
ld [ix],a
inc ix
ret

pbcdb20:ld d,-1
pbcdb21:
inc d
sub b
jr nc,pbcdb21

add a,b

ex af,af'
ld a,d
and a
jr z,pbcdb22

add a,'0'
ld [ix],a
inc ix
ld c,1
jr pbcdb23
pbcdb22:
inc c
dec c
jr z,pbcdb23

ld [ix],'0'
inc ix

pbcdb23:ex af,af'
ret

itof16: ;hl=int --> acc1=float
ld a,h
or l
jr nz,itof1600

ld [acc1+1],a
ret
itof1600:
ld a,h
and 128
ld [acc1+0],a
jr z,itof1602
;cf=0
ex de,hl
ld hl,0
sbc hl,de
itof1602:
ld a,h
and a
jr z,itof1611
;16bit
ld bc,(128+16)*256+0
itof1620:
dec b
ld d,h
ld e,l
add hl,hl
jr nc,itof1620
ld hl,acc1+1
ld [hl],b
inc hl
ld [hl],c ;+2
inc hl
ld [hl],c ;+3
inc hl
ld [hl],e ;+4
inc hl
ld [hl],d ;+5
ret

itof1611: ;8bit
ld a,l
ld bc,(128+8)*256+0
itof1610:
dec b
add a,a
jr nc,itof1610
rra
ld hl,acc1+1
ld [hl],b
inc hl
ld [hl],c ;+2
inc hl
ld [hl],c ;+3
inc hl
ld [hl],c ;+4
inc hl
ld [hl],a ;+5
ret

itof: ;a=int --> acc1=float
and a
jr nz,itof00

ld [acc1+1],a
ret
itof00:
jp p,itof02

ex af,af'
ld a,128
ld [acc1+0],a
ex af,af'
neg
jr itof01
itof02:
ex af,af'
xor a
ld [acc1+0],a
ex af,af'
itof01:
ld bc,(128+8)*256+0
itof10: dec b
add a,a
jr nc,itof10
rra
ld hl,acc1+1
ld [hl],b
inc hl
ld [hl],c ;+2
inc hl
ld [hl],c ;+3
inc hl
ld [hl],c ;+4
inc hl
ld [hl],a ;+5
ret

ftoi16: ;acc1 --> hl=int acc1, cf=status
;範囲は-8191〜8191、範囲外はcf=1
;1) acc1の整数部を取る
;2) ただしacc1が負で小数部が0でない場合は-1する
;int(2)=2, int(1.9)=1, int(1)=1, int(0.9)=0, int(0)=0
;int(-2)=-2, int(-1.9)=-2, int(-1.1)=-2, int(-1)=-1, int(-0.9)=-1, int(-0.1)=-1
call ftoi1600
ret c
ld b,a
bit 7,c
ret z ;cf=0, 正数
;負数
ex de,hl
xor a
ld h,a
ld l,a
sbc hl,de
ld a,b
and a
ret z ;cf=0, 小数部が0の負数
dec hl
ret ;cf=0, 小数部が0でない負数

ftoi1600: ;acc1 --> hl=int abs acc1, c=sign, a=0なら小数部は0, cf=status
ld bc,[acc1+0]
ld hl,0
ld a,b
and a
jr z,ftoi1620
sub 128
ccf
ret nc ;hl=0, a!=0, cf=0
inc a
ld de,[acc1+4]
ld hl,0
cp 8
jr c,ftoi1611
ld l,d
ld d,e
ld e,0
sub 8
jr z,ftoi1612
ftoi1611:
ld b,a
ftoi1610:
ex de,hl
add hl,hl
ex de,hl
adc hl,hl
bit 5,h
scf
ret nz
djnz ftoi1610
ftoi1612:
ld a,d
or e
ld de,[acc1+2]
or d
or e
ret ;cf=0

ftoi1620: ;hl=0, a=0, cf=0
ld c,a
ret

ftoi: ;acc1 --> a=int abs acc1, c=sign, cf=status
ld bc,[acc1+0]
ld a,b
and a
ret z ;cf=0
sub 128
jr c,ftoi00
inc a
ld b,a
ld hl,[acc1+5]
ld h,0
ftoi10:
add hl,hl
bit 7,h
scf
ret nz
djnz ftoi10
ld a,h
and a
ret ;cf=0

ftoi00: xor a
ret ;cf=0

fsub: ;acc1=acc1-acc2, cf=status
ld a,[acc2+0]
xor 128
ld [acc2+0],a
;
fadd: ;acc1=acc1+acc2, cf=status
ld hl,acc2
call is0
ret z ;cf=0
ld hl,acc1
call is0
jr nz,fadd00

ld hl,acc2
ld de,acc1
ld bc,6
ldir
and a ;cf=0
ret
fadd00:
ld bc,0
ld hl,[acc1+2]
ld de,[acc2+2]
exx
ld hl,[acc1+4]
ld de,[acc2+4]

ld a,[acc2+1]
ld b,a
ld a,[acc1+1]
sub b
ld b,a
jr nz,fadd10

ld a,h
cp d
jr nz,fadd10
ld a,l
cp e
jr nz,fadd10

exx
ld a,h
cp d
jr nz,fadd11
ld a,l
cp e

fadd11: exx

fadd10:
jr nc,fadd20

;abs acc2 > abs acc1

ld a,[acc2+1]
ld [acc1+1],a

ld a,[acc2+0]
ld c,a
ex af,af'
ld a,[acc1+0]
cp c
ex af,af'
ld [acc1+0],a

ld a,b
neg
ld b,a

ex de,hl
exx
ex de,hl
exx
jr fadd21

fadd20:
;abs acc1 >= abs acc2

ld a,[acc1+0]
ld c,a
ex af,af'
ld a,[acc2+0]
cp c
ex af,af'
fadd21:
ld a,b
and a
jr z,fadd22

cp 40
jp nc,fadd30

cp 8
jr c,fadd23

sub 8
ld b,a
exx
ld c,e
ld e,d
exx
ld a,e
exx
ld d,a
exx
ld e,d
ld d,0
jr fadd21
fadd23:
srl d
rr e
exx
rr d
rr e
rr c
exx
djnz fadd23
fadd22:
ld a,[acc1+1]
ld b,a

ex af,af'
jr nz,fsub40

;同符号
exx
ld a,b
add a,c
ld b,a
adc hl,de
exx
adc hl,de
jr nc,fadd41

inc b
scf
ret z ;cf=1
rr h
rr l
exx
rr h
rr l
rr b
exx
fadd41:
;丸め
exx
bit 7,b
jr z,fadd42

inc l
jr nz,fadd42
inc h
jr nz,fadd42
exx
inc l
jr nz,fadd43
inc h
jr nz,fadd43
ld h,&80
inc b
scf
ret z ;cf=1
jr fadd43

fadd42: exx

fadd43: ld [acc1+0],bc
ld [acc1+4],hl
exx
ld [acc1+2],hl
and a ;cf=0
ret

fsub40: ;異符号
exx
ld a,b
sub c
ld b,a
sbc hl,de
exx
sbc hl,de

ld a,h
or l
exx
or h
or l
or b
exx
jr nz,fsub41

fsub43: xor a
ld [acc1+1],a
ret ;cf=0

fsub41: ld a,h
and a
jr nz,fsub42

ld a,b
sub 8
jr c,fsub43
jr z,fsub43
ld b,a

ld h,l
exx
ld a,h
exx
ld l,a
exx
ld h,l
ld l,b
exx
jr fsub41

fsub42: bit 7,h
jr nz,fadd41 ;丸め

exx
sla b
adc hl,hl
exx
adc hl,hl

dec b
jr nz,fsub42
jr fsub43

fadd30: ld a,c
ld [acc1+0],a
ld [acc1+4],hl
exx
ld [acc1+2],hl
and a ;cf=0
ret

frcp: ;acc1=1/acc1, cf=status
ld hl,acc1
ld de,acc2
call mtom
ld hl,float1
ld de,acc1
call mtom
;
fdiv: ;acc1=acc1/acc2, cf=status
ld hl,acc2
call is0
scf
ret z
ld hl,acc1
call is0
ret z ;cf=0

ld hl,[acc1+2]
ld de,[acc2+2]
ld bc,0
exx
ld hl,[acc1+4]
ld de,[acc2+4]

ld bc,&0800
call fdiv00
jr nc,fdiv12
exx
inc b
add hl,hl
exx
adc hl,hl
;(cf=1)
jr fdiv15

fdiv10: call fdiv00
jr c,fdiv14

fdiv12: scf
fdiv15: rl c
exx
;(cf=0)
sbc hl,de
exx
sbc hl,de
;
fdiv11: exx
add hl,hl
exx
adc hl,hl
jr nc,fdiv13

djnz fdiv15 ;cf=1

ld a,c
ld [acc1+5],a
;next(sub32 OK)
ld bc,&0800
jr fdiv22

fdiv14: and a ;cf=0
rl c
jr fdiv11

fdiv13: djnz fdiv10
ld a,c
ld [acc1+5],a
;next

ld bc,&0800
fdiv20: call fdiv00
jr c,fdiv24

fdiv22: scf
fdiv25: rl c
exx
;(cf=0)
sbc hl,de
exx
sbc hl,de
;
fdiv21: exx
add hl,hl
exx
adc hl,hl
jr nc,fdiv23

djnz fdiv25 ;cf=1

ld a,c
ld [acc1+4],a
;next(sub32 OK)
ld bc,&0800
jr fdiv32

fdiv24: and a ;cf=0
rl c
jr fdiv21

fdiv23: djnz fdiv20
ld a,c
ld [acc1+4],a
;next

ld bc,&0800
fdiv30: call fdiv00
jr c,fdiv34

fdiv32: scf
fdiv35: rl c
exx
;(cf=0)
sbc hl,de
exx
sbc hl,de
;
fdiv31: exx
add hl,hl
exx
adc hl,hl
jr nc,fdiv33

djnz fdiv35 ;cf=1

ld a,c
ld [acc1+3],a
;next(sub32 OK)
ld bc,&0800
jr fdiv42

fdiv34: and a ;cf=0
rl c
jr fdiv31

fdiv33: djnz fdiv30
ld a,c
ld [acc1+3],a
;next

ld bc,&0800
fdiv40: call fdiv00
jr c,fdiv44

fdiv42: scf
fdiv45: rl c
exx
;(cf=0)
sbc hl,de
exx
sbc hl,de
;
fdiv41: exx
add hl,hl
exx
adc hl,hl
jr nc,fdiv43

djnz fdiv45 ;cf=1

ld a,c
ld [acc1+2],a
;next(sub32 OK)
jr fdiv52

fdiv44: and a ;cf=0
rl c
jr fdiv41

fdiv43: djnz fdiv40
ld a,c
ld [acc1+2],a
;next

call fdiv00
jr c,fdiv51
fdiv52:
ld hl,[acc1+4]
exx
ld hl,[acc1+2]
inc l
jr nz,fdiv53
inc h
jr nz,fdiv53
exx
inc l
jr nz,fdiv54
inc h
jr nz,fdiv54
ld h,&080
exx
inc c
exx
;
fdiv54: exx
fdiv53: ld [acc1+2],hl
exx
ld [acc1+4],hl
fdiv51:
ld a,[acc1+1]
ld b,a
ld a,[acc2+1]
sub 128
jr nc,fdiv60

neg
ld c,a
ld a,b
add a,c
jr nc,fdiv61
ret ;cf=1

fdiv60: ld c,a
ld a,b
sub c
jr z,fdiv70
jr c,fdiv70
;
fdiv61: exx
sub b
jr z,fdiv70
add a,c
ret c

ld [acc1+1],a

ld a,[acc1+0]
ld b,a
ld a,[acc2+0]
xor b
ld [acc1+0],a

ret ;cf=0

fdiv70: xor a
ld [acc1+1],a
ret ;cf=0

fdiv00: ;compare hl:hl' - de:de'--> cf=status
ld a,h
cp d
ret nz
ld a,l
cp e
ret nz
exx
ld a,h
cp d
jr nz,fdiv01
ld a,l
cp e
;
fdiv01: exx
ret

fmul: ;acc1=acc1*acc2, cf=status
ld hl,acc1
call is0
ret z ;cf=0
ld hl,acc2
call is0
jp z,fmul00

ld a,[acc1+2]
ld d,a
exx
ld bc,[acc1+3]
ld a,[acc1+5]
ld d,a
xor a
ex af,af'
xor a
ld h,a
ld l,a
exx
ld e,a
ld h,a
ld l,a

ld bc,[acc2+5]
ld b,8
fmul10: sla c
jr c,fmul11
exx
jr fmul12
fmul11: add hl,de
exx
adc hl,bc
adc a,d
jr nc,fmul12
ex af,af'
inc a
ex af,af'
fmul12: srl d
rr b
rr c
exx
rr d
rr e
djnz fmul10

ld bc,[acc2+4]
inc c
dec c
jr nz,fmul201

push af
ld e,d
exx
ld a,c
exx
ld d,a
exx
ld c,b
ld b,d
exx
pop af
jr fmul300

fmul201:
ld b,8
fmul20: sla c
jr c,fmul21
exx
jr fmul22
fmul21: add hl,de
exx
adc hl,bc
adc a,d
jr nc,fmul22
ex af,af'
inc a
ex af,af'
fmul22: srl b
rr c
exx
rr d
rr e
djnz fmul20

fmul300:
ld bc,[acc2+3]
inc c
dec c
jr nz,fmul301

push af
ld e,d
exx
ld a,c
exx
ld d,a
exx
ld c,b
exx
pop af
jr fmul400

fmul301:
ld b,8
fmul30: sla c
jr c,fmul31
exx
jr fmul32
fmul31: add hl,de
exx
adc hl,bc
adc a,d
jr nc,fmul32
ex af,af'
inc a
ex af,af'
fmul32: srl c
exx
rr d
rr e
djnz fmul30

fmul400:
ld bc,[acc2+2]
inc c
dec c
jr z,fmul501

ld b,8
fmul40: sla c
jr nc,fmul41
add hl,de
exx
adc hl,bc
adc a,d
jr nc,fmul42
ex af,af'
inc a
ex af,af'
fmul42: exx
fmul41: srl d
rr e
djnz fmul40

fmul501:
exx
ld c,a
ld a,[acc1+1]
ld b,a
ex af,af'

fmul50: and a
jr z,fmul51
;cf=0
rra
rr c
rr h
rr l
exx
rr h
rr l
exx
inc b
jr nz,fmul50

fmul54: scf
ret ;over flow
fmul51:
exx
bit 7,l
jr z,fmul52
inc h
jr nz,fmul52
exx
inc l
jr nz,fmul53
inc h
jr nz,fmul53
inc c
jr nz,fmul53
ld c,&80
inc b
jr z,fmul54

fmul53: exx

fmul52:
ld a,h
ld [acc1+2],a
exx
ld [acc1+3],hl
ld a,c
ld [acc1+5],a

ld a,[acc2+1]
sub 128
jr nc,fmul60

neg
ld c,a
ld a,b
sub c

jr c,fmul00
jr z,fmul00

jr fmul61
fmul60:
ld c,a
ld a,b
add a,c
jr c,fmul54

fmul61:
ld [acc1+1],a

ld a,[acc1+0]
ld b,a
ld a,[acc2+0]
xor b
ld [acc1+0],a

ret ;cf=0

fmul00: xor a
ld [acc1+1],a
ret ;cf=0

is0: ;hl==ptr acc --> zf=status, cf=0
inc hl
ld a,[hl]
and a
ret

title00: db '3D graphics ver.2.21 for MZ-80B',13
title01: db '(C) 1991, 2008, 2017 by someone',13
title10: db 'Key function:',13
title11: db ' 2,8,4,6,1,3: Roll',13
title111: db ' z,w,a,s,x,c: Roll 4x',13
title12: db ' m: Rendering mode',13
title13: db ' i: Input formula',13
title14: db ' r: Reset degree',13
title20: db 'Save data=',13
title30: db 'Input formula',13
title40: db 'Quit ?(y/n)',13
title50: db 'Sorting...',13

foinit_xyzst: db 'x=s,y=t,r=sqr(s*s+t*t),z=cos(r)*2/(r/3+0.4)',13
foinit_startend_s: db 'a=-8,b=8',13
foinit_startend_t: db 'a=-8,b=8',13
foinit_mesh_s: db 'm=10',13
foinit_mesh_t: db 'm=10',13
foinit_zoom: db 'z=150',13

fomsg_xyzst: db '> x=x(s,t), y=y(s,t), z=z(s,t)',13
fomsg_startend_s: db '> a=start s, b=end s',13
fomsg_startend_t: db '> a=start t, b=end t',13
fomsg_mesh_s: db '> m=mesh s',13
fomsg_mesh_t: db '> m=mesh t',13
fomsg_zoom: db '> z=zoom',13

start_s: db 0,0,0,0,0,0, 0,0,0,0,0,0
end_s: db 0,0,0,0,0,0, 0,0,0,0,0,0
start_t: db 0,0,0,0,0,0, 0,0,0,0,0,0
end_t: db 0,0,0,0,0,0, 0,0,0,0,0,0
mesh_s: dw 0
mesh_s1: dw 0 ;mesh s+1
mesh_t: dw 0
mesh_t1: dw 0 ;mesh t+1
ds: db 0,0,0,0,0,0, 0,0,0,0,0,0 ;(end_s - start_s)/mesh_s
dt: db 0,0,0,0,0,0, 0,0,0,0,0,0 ;(end_t - start_t)/mesh_t
ptrxyz1: dw xyz
ptrxyz2: dw xyz
ptrxyz3: dw xyz
current_s: db 0,0,0,0,0,0, 0,0,0,0,0,0
current_t: db 0,0,0,0,0,0, 0,0,0,0,0,0

current_x:
minx: db 0,0,0,0,0,0
maxx: db 0,0,0,0,0,0
;
current_y:
miny: db 0,0,0,0,0,0
maxy: db 0,0,0,0,0,0
;
current_z:
minz: db 0,0,0,0,0,0
maxz: db 0,0,0,0,0,0

screen: db 0,0,0,0,0,0
eyeoffset: db 0,0,0,0,0,0
zoom: db 0,0,0,0,0,0
z0: db 0,0,0,0,0,0
mmflag: db 0
rendermode: db 0
zoomfactor: dw 150
rollsin: db 0,0,0,0,0,0 ;sin(pi/rollfactor)
rollsinm: db 0,0,0,0,0,0 ;-sin(pi/rollfactor)
rollcos: db 0,0,0,0,0,0 ;cos(pi/rollfactor)
rollfactor: dw 0
mesh_st: dw 0
rollsin1: db 0,0,0,0,0,0 ;sin(pi/rollfactor1)
rollsinm1: db 0,0,0,0,0,0 ;-sin(pi/rollfactor1)
rollcos1: db 0,0,0,0,0,0 ;cos(pi/rollfactor1)
rollfactor1: dw 16 ;+++++++可変としてもよい
rollsin4: db 0,0,0,0,0,0 ;sin(pi/rollfactor4)
rollsinm4: db 0,0,0,0,0,0 ;-sin(pi/rollfactor4)
rollcos4: db 0,0,0,0,0,0 ;cos(pi/rollfactor4)
rollfactor4: dw 4 ;+++++++可変としてもよい

setrollfactor:
ld de,rollsin
ld bc,6*3+2
push hl
push de
push bc
ldir
call setrollfactor00
pop bc
pop hl
pop de
ldir
ret

setrollfactor00:
;[rollsin〜]=回転行列
ld hl,floatpi
call mtox
ld hl,[rollfactor]
call itof16
err51: jp c,err5
ld hl,acc1
call mtox
call div
jr c,err51
ld hl,buffer+0
push hl
call xtom
pop hl
push hl
ld de,acc1
push de
call mtom
call fsin
jr c,err51
pop hl
push hl
ld de,rollsin
call mtom
pop de ;acc1
pop hl ;buffer+0
push de
call mtom
call fcos
jr c,err51
pop hl ;acc1
ld de,rollcos
call mtom
ld hl,rollsin
ld de,rollsinm
push de
call mtom
pop hl
call chs
ret

initformula:
ld hl,foinit_xyzst
ld de,fo_xyzst
call init10
ld hl,foinit_startend_s
ld de,fo_startend_s
call init10
ld hl,foinit_startend_t
ld de,fo_startend_t
call init10
ld hl,foinit_mesh_s
ld de,fo_mesh_s
call init10
ld hl,foinit_mesh_t
ld de,fo_mesh_t
call init10
ld hl,foinit_zoom
ld de,fo_zoom
call init10
ret

init10: ld a,[hl]
inc hl
ld [de],a
inc de
cp 13
jr nz,init10
ret

initvariable:
ld hl,complextmpatoz+1
ld de,6
ld b,2*26
init00: ld [hl],0
add hl,de
djnz init00
ret

initstack:
ld hl,floatstacktop
ld [ptrstackpointer],hl
ret

init: call initstack
call initvariable
ret

start: ld hl,title00
call message
call crlf
ld hl,title01
call message
call crlf

call initformula
;
hotstart:
ld hl,title10
call message
call crlf
ld hl,title11
call message
call crlf
ld hl,title111
call message
call crlf
ld hl,title12
call message
call crlf
ld hl,title13
call message
call crlf
ld hl,title14
call message
call crlf

ld [sp_work],sp

main: ld sp,[sp_work]

in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&01 ;vram表示もしない
out [&f4],a

call init

call crlf
ld hl,title30
call message
call crlf

ld hl,fomsg_xyzst
ld de,fo_xyzst
call inputformula
ld hl,fomsg_startend_s
ld de,fo_startend_s
call inputformula
ld hl,fomsg_startend_t
ld de,fo_startend_t
call inputformula
ld hl,fomsg_mesh_s
ld de,fo_mesh_s
call inputformula
ld hl,fomsg_mesh_t
ld de,fo_mesh_t
call inputformula
ld hl,fomsg_zoom
ld de,fo_zoom
call inputformula
main00:
ld ix,fo_startend_s
call main10
ld hl,complextmpatoz+0*12 ;複素変数a
ld de,start_s
call mctomc
ld hl,complextmpatoz+1*12 ;複素変数b
ld de,end_s
call mctomc

ld ix,fo_startend_t
call main10
ld hl,complextmpatoz+0*12 ;複素変数a
ld de,start_t
call mctomc
ld hl,complextmpatoz+1*12 ;複素変数b
ld de,end_t
call mctomc

ld ix,fo_mesh_s
call main10
ld hl,complextmpatoz+12*12+0 ;変数mの実数部
ld de,acc1
call mtom
call ftoi16
jp c,err5
bit 7,h
jp nz,err5
ld [mesh_s],hl
inc hl
bit 7,h
jp nz,err5
ld [mesh_s1],hl

ld ix,fo_mesh_t
call main10
ld hl,complextmpatoz+12*12+0 ;変数mの実数部
ld de,acc1
call mtom
call ftoi16
jp c,err5
bit 7,h
jp nz,err5
ld [mesh_t],hl
inc hl
bit 7,h
jp nz,err5
ld [mesh_t1],hl

;end_s - start_s
ld hl,end_s
ld de,floata
call mctomc
ld hl,start_s
ld de,floatc
call mctomc
call nsub
;/mesh_s
ld hl,[mesh_s]
call itof16
ld hl,acc1
ld de,floatc
call mtom
xor a
ld [floatd+1],a
call ndiv
ld hl,floata
ld de,ds
call mctomc

;end_t - start_t
ld hl,end_t
ld de,floata
call mctomc
ld hl,start_t
ld de,floatc
call mctomc
call nsub
;/mesh_t
ld hl,[mesh_t]
call itof16
ld hl,acc1
ld de,floatc
call mtom
xor a
ld [floatd+1],a
call ndiv
ld hl,floata
ld de,dt
call mctomc

ld ix,fo_zoom
call main10
ld hl,complextmpatoz+25*12+0 ;変数zの実数部
ld de,acc1
call mtom
call ftoi16
jp c,err5
bit 7,h
jp nz,err5
ld a,h
or l
jp z,err5
ld [zoomfactor],hl

;[rollsin1〜]=回転行列(1x)
ld hl,rollsin1
call setrollfactor

;[rollsin4〜]=回転行列(4x)
ld hl,rollsin4
call setrollfactor

;データ領域へのポインタを計算する
ld hl,xyz
ld [ptrxyz1],hl
ld de,[mesh_s]
push de
inc de
ld bc,[mesh_t]
push bc
inc bc
ld a,b
and a
jp nz,err6
call imulp
err60: jp c,err6
ex de,hl
ld bc,22 ;*(6*3+2*2)=*22
call imulp
jr c,err60
ld de,xyz
add hl,de
jr c,err60
ld [ptrxyz2],hl
pop bc ;mesh_t
pop de ;mesh_s
call imulp
ld [mesh_st],hl
push hl
ex de,hl
ld bc,22 ;*(2*8+6)=*22
call imulp
jr c,err60
ld de,[ptrxyz2]
add hl,de
jr c,err60
ld [ptrxyz3],hl
ex de,hl
pop hl ;mesh_s*mesh_t
add hl,hl ;*2
jr c,err60
add hl,de
jr c,err60
;仮想vramが使えるか
xor a
ld [vvactive],a
ld hl,vvr
ld de,320*200/8
add hl,de
jr c,calc
ld bc,&d000
;cf=0
sbc hl,bc
jr nc,calc
ld hl,vvr2
add hl,de
jr c,calc
;cf=0
sbc hl,bc
jr nc,calc
inc a
ld [vvactive],a ;vvactive!=0ならば、仮想vramが使える

calc: ld sp,[sp_work]

in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&01 ;vram表示もしない
out [&f4],a

xor a
ld [rendermode],a

;データを計算する
xor a
ld [mmflag],a
ld hl,start_t
ld de,current_t
call mctomc
ld de,[ptrxyz1]
ld bc,[mesh_t1]
calc00:
push bc
ld h,b
ld l,c
call hex
call crlf
push de
ld hl,start_s
ld de,current_s
call mctomc
pop de
ld bc,[mesh_s1]
calc10:
push bc
push de

call initstack
call initvariable
ld hl,current_s
ld de,complextmpatoz+18*12 ;複素変数s
call mctomc
ld hl,current_t
ld de,complextmpatoz+19*12 ;複素変数t
call mctomc
ld ix,fo_xyzst
call main11 ;式を計算

pop de

ld hl,complextmpatoz+23*12+0 ;変数xの実数部
call mtom
ld hl,complextmpatoz+24*12+0 ;変数yの実数部
call mtom
ld hl,complextmpatoz+25*12+0 ;変数zの実数部
call mtom
inc de ;2*2の領域を飛ばす
inc de
inc de
inc de

push de

ld a,[mmflag]
and a
jr nz,calc20
inc a
ld [mmflag],a
ld hl,complextmpatoz+23*12+0 ;変数xの実数部
ld de,minx
push hl
call mtom ;minx
pop hl
call mtom ;maxx
ld hl,complextmpatoz+24*12+0 ;変数yの実数部
push hl
call mtom ;miny
pop hl
call mtom ;maxy
ld hl,complextmpatoz+25*12+0 ;変数zの実数部
push hl
call mtom ;minz
pop hl
call mtom ;maxz
jr calc30
calc20:
ld hl,complextmpatoz+23*12+0 ;変数xの実数部
ld de,minx
push hl
push de
call fcp ;minx-x
pop de
pop hl
call nc,mtom
ld hl,complextmpatoz+23*12+0 ;変数xの実数部
ld de,maxx
push hl
push de
call fcp ;maxx-x
pop de
pop hl
call c,mtom

ld hl,complextmpatoz+24*12+0 ;変数yの実数部
ld de,miny
push hl
push de
call fcp ;miny-y
pop de
pop hl
call nc,mtom
ld hl,complextmpatoz+24*12+0 ;変数yの実数部
ld de,maxy
push hl
push de
call fcp ;maxy-y
pop de
pop hl
call c,mtom

ld hl,complextmpatoz+25*12+0 ;変数zの実数部
ld de,minz
push hl
push de
call fcp ;minz-z
pop de
pop hl
call nc,mtom
ld hl,complextmpatoz+25*12+0 ;変数zの実数部
ld de,maxz
push hl
push de
call fcp ;maxz-z
pop de
pop hl
call c,mtom
calc30:
ld hl,current_s
ld de,floata
push hl
push de
call mctomc
ld hl,ds
ld de,floatc
call mctomc
call nadd
pop hl ;floata
pop de ;current_s
call mctomc

pop de
pop bc
dec bc
ld a,b
or c
jp nz,calc10

push de
ld hl,current_t
ld de,floata
push hl
push de
call mctomc
ld hl,dt
ld de,floatc
call mctomc
call nadd
pop hl ;floata
pop de ;current_t
call mctomc
pop de

pop bc
dec bc
ld a,b
or c
jp nz,calc00

ld hl,minx
call main20
ld hl,miny
call main20
ld hl,minz
call main20

;minx, miny, minz = (min+max)/2
ld hl,minx
call main30
ld hl,miny
call main30
ld hl,minz
call main30

;(0,0,0)を中心にする
ld hl,[ptrxyz1]
calc100:
ld de,[ptrxyz2]
and a
sbc hl,de
jr nc,calc101
add hl,de
;x
push hl
ld de,acc1
call mtom
ld hl,minx
ld de,acc2
call mtom
call fsub
ld hl,acc1
pop de
call mtom
ex de,hl
;y
push hl
ld de,acc1
call mtom
ld hl,miny
ld de,acc2
call mtom
call fsub
ld hl,acc1
pop de
call mtom
ex de,hl
;z
push hl
ld de,acc1
call mtom
ld hl,minz
ld de,acc2
call mtom
call fsub
ld hl,acc1
pop de
call mtom

ld hl,2*2 ;読み飛ばす
add hl,de
jr calc100
calc101:
call hex ;+++++++

;screen=2*sqr(max(x^2+y^2+z^2))
xor a
ld [mmflag],a
ld hl,[ptrxyz1]
calc110:
ld de,[ptrxyz2]
and a
sbc hl,de
jp nc,calc111
add hl,de
;x
push hl
ld de,acc1
call mtom
pop hl
ld de,acc2
call mtom
push hl
call fmul
ld hl,acc1
ld de,buffer+0
call mtom
pop hl
;y
push hl
ld de,acc1
call mtom
pop hl
ld de,acc2
call mtom
push hl
call fmul
ld hl,acc1
ld de,buffer+6
call mtom
pop hl
;z
push hl
ld de,acc1
call mtom
pop hl
ld de,acc2
call mtom
push hl
call fmul
ld hl,acc1
ld de,buffer+12
call mtom

ld hl,buffer+0
ld de,acc1
ld bc,12
ldir
call fadd
ld hl,buffer+12
ld de,acc2
call mtom
call fadd

ld a,[mmflag]
and a
jr nz,calc120
inc a
ld [mmflag],a
ld hl,acc1
ld de,screen
call mtom
jr calc121
calc120:
ld hl,acc1
ld de,screen
push hl
push de
call fcp ;screen-acc1
pop de
pop hl
call c,mtom
calc121:
pop hl

ld de,2*2 ;読み飛ばす
add hl,de
jp calc110
calc111:
call hex ;+++++++
call crlf ;+++++++

ld hl,screen
push hl
ld de,acc1
push de
call mtom
call fsqrt
pop hl
pop de
call mtom
ld hl,screen+1 ;screen*=2
inc [hl]

;eyeoffset=screen*1.6
ld a,16
call itof
ld hl,acc1
push hl
call mtox
ld a,10
call itof
pop hl
call mtox
call div ;16/10+++++++
ld hl,screen
call mtox
call mul
ld hl,eyeoffset
call xtom

;zoom=zoomfactor/screen
ld hl,[zoomfactor]
call itof16
ld hl,acc1
call mtox
ld hl,screen
call mtox
call div
ld hl,zoom
call xtom

;screen=screen+eyeoffset
ld hl,screen
push hl
call mtox
ld hl,eyeoffset
call mtox
call ad
pop hl
call xtom

call clsc

loop: ;メインループ
ld sp,[sp_work]

ld hl,[ptrxyz1]
loop100:
ld de,[ptrxyz2]
and a
sbc hl,de
jp nc,loop101
add hl,de

ld de,current_x
call mtom
ld de,current_y
call mtom
ld de,current_z
call mtom

push hl

ld hl,screen
call mtox
ld hl,current_z
call mtox
ld hl,eyeoffset
call mtox
call ad ;z+eyeoffset
jp c,err5
call div ;screen/(z+eyeoffset)
jp c,err5
ld hl,zoom
call mtox
call mul ;*zoom
jp c,err5
ld hl,z0
call xtom

ld hl,current_x
call mtox
ld hl,z0
call mtox
call mul
jp c,err5
ld hl,acc1
call xtom
call ftoi16
jp c,err5
ld de,160
add hl,de
ex de,hl

pop hl ;disp x
ld [hl],e
inc hl
ld [hl],d
inc hl
push hl

ld hl,current_y
call mtox
ld hl,z0
call mtox
call mul
jp c,err5
ld hl,acc1
call xtom
call ftoi16
jp c,err5
ld de,100
add hl,de
ex de,hl

pop hl ;disp y
ld [hl],e
inc hl
ld [hl],d
inc hl

jp loop100
loop101:
call clsv

ld a,[rendermode]
and a
jp nz,loop200

;mode=0（ライン）

ld de,[mesh_s1]
ld bc,6*3+2*2
call imulp
ld [buffer+0],hl

ld hl,[ptrxyz1]
loop110:
call keyint ;キー割込みがあるか

ld [buffer+2],hl
ld de,[ptrxyz2]
and a
sbc hl,de
jp nc,loop111
add hl,de

ld bc,[mesh_s]
jr loop121
loop120:
push bc

ld de,6*3
add hl,de ;読み飛ばす

ld de,dr_x1
ldi ;x
ldi
ldi ;y
ldi

push hl
ld de,6*3
add hl,de
ld de,dr_x2
ldi ;x
ldi
ldi ;y
ldi
call line
pop hl

pop bc
dec bc
loop121:
ld a,b
or c
jr nz,loop120

ld hl,[buffer+2]
ld de,[buffer+0]
add hl,de
jp loop110
loop111:

ld hl,[ptrxyz1]
ld de,[buffer+0]
add hl,de
ld [buffer+4],hl
ld hl,[ptrxyz1]
loop130:
call keyint ;キー割込みがあるか

ld [buffer+2],hl
ld de,[buffer+4]
and a
sbc hl,de
jp nc,loop131
add hl,de

ld bc,[mesh_t]
jr loop141
loop140:
push bc

ld de,6*3
add hl,de ;読み飛ばす

ld de,dr_x1
ldi ;x
ldi
ldi ;y
ldi

ld de,-(6*3+2*2)
add hl,de ;戻す

ld de,[buffer+0]
add hl,de ;次のアドレス

push hl
ld de,6*3
add hl,de
ld de,dr_x2
ldi ;x
ldi
ldi ;y
ldi
call line
pop hl

pop bc
dec bc
loop141:
ld a,b
or c
jr nz,loop140

ld hl,[buffer+2]
ld de,6*3+2*2
add hl,de
jp loop130
loop131:

jp loop300 ;キー入力待ちへ

loop200: ;mode=1（ソリッド）
ld de,[mesh_s1]
ld bc,6*3+2*2
call imulp
ld [buffer+0],hl
ld hl,[ptrxyz2]
ld [buffer+2],hl

ld hl,[ptrxyz1]
ld bc,[mesh_t]
jp loop211
loop210:
push bc

ld bc,[mesh_s]
jp loop241
loop240:
push bc

;４角形の座標をセットする
ld de,[buffer+2]
push hl
ld bc,6*3
add hl,bc
ldi ;x1
ldi
ldi ;y1
ldi
ld bc,6*3
add hl,bc
ldi ;x2
ldi
ldi ;y2
ldi
ld bc,[buffer+0] ;縦方向
add hl,bc
ld bc,-(2*2)
add hl,bc
ldi ;x3
ldi
ldi ;y3
ldi
ld bc,-((6*3+2*2)+(2*2))
add hl,bc
ldi ;x4
ldi
ldi ;y4
ldi
pop hl
ld [buffer+2],de

;視点からの距離（xyz/4 - eye）をセットする
push hl
ld de,current_x+0*6
ld bc,6*3
ldir
ld bc,2*2
add hl,bc
call loop220 ;current_xyz+=xyz, hl=hl+6*3
pop hl

push hl

ld bc,[buffer+0] ;縦方向
add hl,bc
call loop220 ;current_xyz+=xyz, hl=hl+6*3
ld bc,2*2
add hl,bc
call loop220 ;current_xyz+=xyz, hl=hl+6*3

ld hl,current_x+0*6
call loop230 ;x/4
dec hl
push hl
call mtox
pop hl
call mtox
call mul ;(x/4)^2

ld hl,current_x+1*6
call loop230 ;y/4
dec hl
push hl
call mtox
pop hl
call mtox
call mul ;(y/4)^2

ld hl,current_x+2*6
call loop230 ;z/4
dec hl
push hl
call mtox
ld hl,eyeoffset
call mtox
call sb ;z/4-eyeoffset
pop hl
push hl
call xtom
pop hl
push hl
call mtox
pop hl
call mtox
call mul ;(z/4-eyeoffset)^2

call ad ;+(y/4)^2
call ad ;+(x/4)^2

ld hl,[buffer+2]
call xtom
ld [buffer+2],de

pop hl

ld bc,6*3+2*2
add hl,bc

pop bc
dec bc
loop241:
ld a,b
or c
jp nz,loop240

ld bc,6*3+2*2
add hl,bc

pop bc
dec bc
loop211:
ld a,b
or c
jp nz,loop210

ld hl,[buffer+2] ;+++++++
ld de,[ptrxyz3]
and a
sbc hl,de
call hex
call crlf

ld hl,[ptrxyz2]
ld de,[ptrxyz3]
ld bc,[mesh_st]
jr loop251
loop250:
ex de,hl
ld [hl],e
inc hl
ld [hl],d
inc hl
ex de,hl

push bc
ld bc,2*8+6
add hl,bc
pop bc

dec bc
loop251:
ld a,b
or c
jr nz,loop250

ld hl,title50 ;+++++++
call message
call crlf

call qsort
call c,sort

call clsc

ld hl,[ptrxyz3]
ld bc,[mesh_st]
jr loop261
loop260:
push bc

call keyint ;+++++++

ld e,[hl]
inc hl
ld d,[hl]
inc hl
push hl

ex de,hl
ld de,p4_x1+0
ld bc,2*8
ldir

call p4_polygon
ld a,[cr_flag]
and a
push af
call z,p4_bline
pop af
call nz,p4_bline2

pop hl
pop bc
dec bc
loop261:
ld a,b
or c
jr nz,loop260

jp loop300

qsort: ;[[ptrxyz3]〜]をdistanceの遠い順にソートする。cf=status
ld hl,[mesh_st]
ld a,h
or l
ret z ;データ個数=0, cf=0
dec hl
ld a,h
or l
ret z ;データ個数=1, cf=0

ld a,[vvactive]
and a
scf
ret z

ld [sort_wsp],sp
ld sp,vvr+320*200/8*2-1 ;仮想vramが空いているのでスタックに使う

ld [sort_last],hl ;[mesh_st]-1
ld hl,0
ld [sort_first],hl

call qsort00

ld sp,[sort_wsp]
ret

qsort00: ;[sort_first]:first, [sort_last]:last
ld hl,[sort_first]
ld de,[sort_last]
add hl,de
rr h
rr l
add hl,hl
ld de,[ptrxyz3]
add hl,de
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
ld de,2*8
add hl,de
ld de,sort_w01 ;x=a[(first+last)/2]
ld bc,6
ldir

;i=first
ld ix,[sort_first]
;j=last
ld iy,[sort_last]
qsort10:
;while(a[i] < x) i++;
push ix
pop hl
add hl,hl
ld de,[ptrxyz3]
add hl,de
ld [sort_ptr00],hl ;i
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
ld de,2*8
add hl,de ;a[i]
ld de,sort_w01 ;x
ex de,hl
call fcp ;a[i]-x
jr nc,qsort20
inc ix
jr qsort10
qsort20:
;while(x < a[j]) j--;
push iy
pop hl
add hl,hl
ld de,[ptrxyz3]
add hl,de
ld [sort_ptr01],hl ;j
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
ld de,2*8
add hl,de ;a[j]
ld de,sort_w01 ;x
call fcp ;x-a[j]
jr nc,qsort21
dec iy
jr qsort20
qsort21:
;if( i >= j ) break;
push ix
pop hl
push iy
pop de
and a
sbc hl,de ;i-j
bit 7,h
jr z,qsort30

;xchg a[i],a[j]
push ix
push iy
ld ix,[sort_ptr00]
ld iy,[sort_ptr01]
ld l,[ix+0]
ld h,[ix+1]
ld e,[iy+0]
ld d,[iy+1]
ld [ix+0],e
ld [ix+1],d
ld [iy+0],l
ld [iy+1],h
pop iy
pop ix

;i++; j--;
inc ix
dec iy
jp qsort10
qsort30:
;if(first < i-1) qsort(first, i-1)
push ix
pop de
dec de ;i-1
ld hl,[sort_first]
and a
sbc hl,de ;first - (i-1)
bit 7,h
jr z,qsort31

ld hl,[sort_last]
push hl
ld [sort_last],de ;i-1
call qs_stackcheck
call qsort00
pop hl
ld [sort_last],hl
qsort31:
;if(j+1 < last) qsort(j+1, last)
push iy
pop hl
inc hl ;j+1
ld de,[sort_last]
and a
sbc hl,de ;(j+1) - last
bit 7,h
jr z,qsort32

add hl,de ;j+1
ex de,hl
ld hl,[sort_first]
push hl
ld [sort_first],de ;j+1
call qs_stackcheck
call qsort00
pop hl
ld [sort_first],hl
qsort32:
and a
ret ;cf=0

qs_stackcheck:
ld hl,vvr+256 ;+++++++
and a
sbc hl,sp
ret c

ld sp,[sort_wsp]

ld hl,sort_msg00 ;+++++++
call message
call crlf

scf
ret

sort_msg00: db 'Quick sort failed, trying normal sort...',13
sort_ptr00: dw 0
sort_ptr01: dw 0
sort_first: dw 0
sort_last: dw 0
sort_wsp: dw 0

sort_w00: dw 0
sort_w01: db 0,0,0,0,0,0

sort: ld hl,[mesh_st]
ld a,h
or l
ret z ;データ個数=0
dec hl
ld a,h
or l
ret z ;データ個数=1
ld [sort_w00],hl

ld bc,0
ld ix,[ptrxyz3]
sort00:
ld e,[ix+0]
ld d,[ix+1]
inc ix
inc ix

ld hl,2*8
add hl,de
ld de,sort_w01
push bc
ld bc,6
ldir ;distance(1)
pop bc

inc bc
push bc

push ix
pop iy
sort10:
ld e,[iy+0]
ld d,[iy+1]
inc iy
inc iy

ld hl,2*8
add hl,de ;distance(2)

ld de,sort_w01 ;distance(1)

push bc
ex de,hl
call fcp ;[de]-[hl]
pop bc
jr nc,sort11

;[ix-2〜] <--> [iy-2〜]
ld l,[ix-2]
ld h,[ix-1]
ld e,[iy-2]
ld d,[iy-1]
ld [ix-2],e
ld [ix-1],d
ld [iy-2],l
ld [iy-1],h

ld hl,2*8
add hl,de
ld de,sort_w01
push bc
ld bc,6
ldir ;new distance(1)
pop bc
sort11:
inc bc

ld hl,[mesh_st]
and a
sbc hl,bc

jr nz,sort10

pop bc

ld hl,[sort_w00]
and a
sbc hl,bc

jr nz,sort00

ret

loop230:
inc hl
ld a,[hl]
and a
ret z
dec [hl] ;/2
ret z
dec [hl] ;/4
ret

loop220:
call mtox ;x
push hl
ld hl,current_x+0*6 ;x
push hl
call mtox
call ad
pop hl
call xtom
pop hl

call mtox ;y
push hl
ld hl,current_x+1*6 ;y
push hl
call mtox
call ad
pop hl
call xtom
pop hl

call mtox ;z
push hl
ld hl,current_x+2*6 ;z
push hl
call mtox
call ad
pop hl
call xtom
pop hl

ret

loop300:
call keyint ;キー割込みがあるか
jr loop300

keyint10:
push de
push bc
ld de,rollsin
ld bc,6*3
ldir
pop bc
pop de
ret

keyint: ;キー割込みがあるか
push hl
call _getkey
pop hl

and a
ret z

cp 11
jp z,keyint00

cp 'I'
jp z,main

cp 'R'
jp z,calc

cp 'M'
jr z,mode

push hl
ld hl,rollsin1
call keyint10
pop hl

cp '2'
jp z,rollyz0
cp '8'
jp z,rollyz1

cp '4'
jp z,rollzx0
cp '6'
jp z,rollzx1

cp '1'
jp z,rollxy0
cp '3'
jp z,rollxy1

push hl
ld hl,rollsin4
call keyint10
pop hl

cp 'Z'
jr z,rollyz0
cp 'W'
jr z,rollyz1

cp 'A'
jp z,rollzx0
cp 'S'
jp z,rollzx1

cp 'X'
jp z,rollxy0
cp 'C'
jp z,rollxy1

ret

mode: ld a,[rendermode]
xor 1
ld [rendermode],a
jp loop

rollyz0:xor a
jr rollyz
rollyz1:ld a,1
rollyz: ld [mmflag],a
;
ld hl,[ptrxyz1]
rollyz00:
ld de,[ptrxyz2]
and a
sbc hl,de
jp nc,loop
add hl,de

ld de,6
add hl,de

push hl
call mtox ;y
ld hl,rollcos
call mtox
call mul ;cos*y
jp c,err5
pop hl

ld de,6
add hl,de

push hl
call mtox ;z
ld hl,rollsinm
ld a,[mmflag]
and a
jr z,rollyz10
ld hl,rollsin
rollyz10:
call mtox
call mul ;-+sin*z
jp c,err5
call ad ;cos*y-+sin*z
jp c,err5
ld hl,buffer+0
call xtom
pop hl

ld de,-6
add hl,de

push hl
call mtox ;y
ld hl,rollsin
ld a,[mmflag]
and a
jr z,rollyz11
ld hl,rollsinm
rollyz11:
call mtox
call mul ;+-sin*y
jp c,err5
pop hl

ld de,6
add hl,de

push hl
call mtox ;z
ld hl,rollcos
call mtox
call mul ;cos*z
jp c,err5
call ad ;+-sin*y+cos*z
jp c,err5
ld hl,buffer+6
call xtom
pop hl

ld de,-6
add hl,de

ex de,hl ;de=y
ld hl,buffer+0
call mtom ;y
ld hl,buffer+6
call mtom ;z

ld hl,2*2
add hl,de

jp rollyz00

rollzx0:xor a
jr rollzx
rollzx1:ld a,1
rollzx: ld [mmflag],a
;
ld hl,[ptrxyz1]
rollzx00:
ld de,[ptrxyz2]
and a
sbc hl,de
jp nc,loop
add hl,de

push hl
ld de,6+6
add hl,de
call mtox ;z
ld hl,rollcos
call mtox
call mul ;cos*z
jp c,err5
pop hl

push hl
call mtox ;x
ld hl,rollsinm
ld a,[mmflag]
and a
jr z,rollzx10
ld hl,rollsin
rollzx10:
call mtox
call mul ;-+sin*x
jp c,err5
call ad ;cos*z-+sin*x
jp c,err5
ld hl,buffer+0
call xtom
pop hl

push hl
ld de,6+6
add hl,de
call mtox ;z
ld hl,rollsin
ld a,[mmflag]
and a
jr z,rollzx11
ld hl,rollsinm
rollzx11:
call mtox
call mul ;+-sin*z
jp c,err5
pop hl

push hl
call mtox ;x
ld hl,rollcos
call mtox
call mul ;cos*x
jp c,err5
call ad ;+-sin*z+cos*x
jp c,err5
ld hl,buffer+6
call xtom
pop hl

ex de,hl ;de=x
ld hl,buffer+6
call mtom ;x
ld hl,6
add hl,de
ex de,hl ;de=z
ld hl,buffer+0
call mtom ;z

ld hl,2*2
add hl,de

jp rollzx00

rollxy0:xor a
jr rollxy
rollxy1:ld a,1
rollxy: ld [mmflag],a
;
ld hl,[ptrxyz1]
rollxy00:
ld de,[ptrxyz2]
and a
sbc hl,de
jp nc,loop
add hl,de

push hl
call mtox ;x
ld hl,rollcos
call mtox
call mul ;cos*x
jp c,err5
pop hl

ld de,6
add hl,de

push hl
call mtox ;y
ld hl,rollsinm
ld a,[mmflag]
and a
jr z,rollxy10
ld hl,rollsin
rollxy10:
call mtox
call mul ;-+sin*y
jp c,err5
call ad ;cos*x-+sin*y
jp c,err5
ld hl,buffer+0
call xtom
pop hl

ld de,-6
add hl,de

push hl
call mtox ;x
ld hl,rollsin
ld a,[mmflag]
and a
jr z,rollxy11
ld hl,rollsinm
rollxy11:
call mtox
call mul ;+-sin*x
jp c,err5
pop hl

ld de,6
add hl,de

push hl
call mtox ;y
ld hl,rollcos
call mtox
call mul ;cos*y
jp c,err5
call ad ;+-sin*x+cos*y
jp c,err5
ld hl,buffer+6
call xtom
pop hl

ld de,-6
add hl,de

ex de,hl ;de=x
ld hl,buffer+0
call mtom ;x
ld hl,buffer+6
call mtom ;y

ld hl,6+2*2
add hl,de

jp rollxy00

keyint00:
in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&01 ;vram表示もしない
out [&f4],a

push hl
call crlf
ld hl,title40
call message
call crlf
pop hl
keyint01:
call keywait
cp 'Y'
jp z,mainend
cp 'N'
jr nz,keyint01
push hl
call clsc
pop hl

ld a,&03 ;vram表示する
out [&f4],a

ret

keywait:
push hl
call _getkey
pop hl
and a
jr z,keywait
ret

err5: ld a,5 ;over flow
jp err

err6: ld a,6 ;out of memory
jp err

main30: push hl
ld de,acc1
ld bc,12
ldir
call fadd
jr c,err5
ld a,[acc1+1]
and a
jr z,main31
dec a
ld [acc1+1],a
main31: ld hl,acc1
pop de
jp mtom

main10: ;ix=数式の文字列へのポインタ → 式を評価する。結果は変数領域[complextmpatoz〜]
call initstack
call initvariable
main11:
call getformula
call spcs
ld a,[ix]
cp 13
jp nz,err1
ret

main20: ld de,acc1
push de
call mtom
push hl
ld ix,buffer
call printbcdacc1
ld [ix],' '
inc ix
pop hl
pop de
call mtom
call printbcdacc1
ld [ix],13
ld hl,buffer
call message
jp crlf

mainend: ;終了
in a,[&e8] ;vramアクセス禁止
res 7,a
out [&e8],a
ld a,&01 ;vram表示もしない
out [&f4],a

call crlf
ld hl,title20
call message
ld hl,savedata
call hex
ld a,'-'
call _pcha
ld hl,savedataend
call hex
call crlf

jp monitor

inputformula: ;数式の入力
push de
call message
call crlf
pop hl
push hl
call message
ld a,'?'
call _pcha
call crlf
call input
jr nc,inf00

call crlf
ld hl,title40
call message
call crlf
inf10:
call keywait
cp 'Y'
jr z,mainend
cp 'N'
jr nz,inf10
ld a,13
ld [_ptrinputdata],a
inf00:
ld hl,_ptrinputdata
ld a,[hl]
cp 13
pop de
ret z ;空入力の時は式を変更しない
call init10
ret

dumpacc:ld b,6
dumpacc00:
ld a,[hl]
inc hl
call hex8
call space
djnz dumpacc00
ret

;****** bios for mz-80b

_monitor= &00b1
_pcha= &08c6
_hex4= &05f3
_input= &06a4
_maxinputstroke=&06a2
_ptrinputdata= &1093
_getkey= &0832

;_input de=入力バッファアドレス
; [_maxinputstroke]: 最大入力文字数（最大79まで設定可）
; [_ptrinputdata+0]=&0b :breakキーが押された
; [_ptrinputdata~]=入力データ（13で終わる）

input: ;cf=0:enterキーが押された
;cf=1:breakキーが押された
;[_ptrinputdata~]=入力データ（大文字を小文字に変換、13で終わる）
ld a,79
ld [_maxinputstroke],a
ld de,_ptrinputdata
call _input ;de保存
ex de,hl
ld a,[hl]
cp &0b
scf
ret z ;cf=1

input00:ld a,[hl]
cp 13
ret z ;cf=0
cp 'A'
jr c,input01
cp 'Z'+1
jr nc,input01
add a,&20
ld [hl],a
input01:inc hl
jr input00

monitor:jp _monitor

crlf: ld a,13
;
pcha: jp _pcha

space: ld a,' '
jr pcha

hex: push hl
push hl
ld a,h
call hex8
pop hl
ld a,l
call hex8
pop hl
ret

hex8: push af
rra
rra
rra
rra
and &0f
call _hex4
call _pcha
pop af
and &0f
call _hex4
jr pcha

message: ;hl:pointer, end mark=&0d
ld a,[hl]
cp &0d
ret z
call _pcha
inc hl
jr message

;******プログラム終了
endaddress:

datastart00=endaddress ;float 作業用

acc1= datastart00+6*0
acc2= datastart00+6*1
acc3= datastart00+6*2
acc4= datastart00+6*3
acc5= datastart00+6*4
acc6= datastart00+6*5
acc7= datastart00+6*6
acc8= datastart00+6*7
ftmpx= datastart00+6*8
ftmpy= datastart00+6*9
fnlna= datastart00+6*10
fnlnb= datastart00+6*11
fnlnc= datastart00+6*12

datastart10=datastart00+6*13 ;int 作業用

intwork00=datastart10+2*0
sp_work=datastart10+2*1 ;spレジスタ保存

datastart20=datastart10+2*2 ;char 作業用

charwork00=datastart20+1*0
charwork01=datastart20+1*1
charwork02=datastart20+1*10

datastart30=datastart20+1*11 ;complex tmp a〜z 式評価用一時変数

complextmpatoz=datastart30

datastart40=datastart30+12*26 ;float a〜z 作業用

floata= datastart40+6*0
floatb= datastart40+6*1
floatc= datastart40+6*2
floatd= datastart40+6*3
floate= datastart40+6*4
floatf= datastart40+6*5
floatg= datastart40+6*6
floath= datastart40+6*7
floati= datastart40+6*8
floatj= datastart40+6*9
floatk= datastart40+6*10
floatl= datastart40+6*11
floatm= datastart40+6*12
floatn= datastart40+6*13
floato= datastart40+6*14
floatp= datastart40+6*15
floatq= datastart40+6*16
floatr= datastart40+6*17
floats= datastart40+6*18
floatt= datastart40+6*19
floatu= datastart40+6*20
floatv= datastart40+6*21
floatw= datastart40+6*22
floatx= datastart40+6*23
floaty= datastart40+6*24
floatz= datastart40+6*25

datastart50=datastart40+6*26 ;計算用スタック

ptrstackpointer=datastart50
floatstack=datastart50+2*1
floatstacktop=floatstack+256

datastart60=datastart50+2+256 ;式計算作業用

formulawork=datastart60
floatformula_a=datastart60
floatformula_b=datastart60+6
charformula_entrylevel=datastart60+12
ptrformula_execaddress=datastart60+13
charformula_leftvalue=datastart60+15

datastart70=datastart60+16

buffer=datastart70 ;文字表示用バッファー

savedata=datastart70+80 ;セーブデータ領域
fo_xyzst= savedata+80*0
fo_startend_s= savedata+80*1
fo_startend_t= savedata+80*2
fo_mesh_s= savedata+80*3
fo_mesh_t= savedata+80*4
fo_zoom= savedata+80*5
savedataend=savedata+80*6

vvr=savedataend ;仮想vram(320*200)
vvr2=vvr+320*200/8 ;仮想vram2(320*200)

xyz=vvr2+320*200/8 ;1) 実数座標(x,y,z)および整数座標(x,y)が(mesh_s1)*(mesh_t1)個
;2) ４角形ポリゴン整数座標(x1,y1,x2,y2,x3,y3,x4,y4)
; および視点からの実数距離(d)
; がmesh_s*mesh_t個
;3) 2)へのポインタ配列がmesh_s*mesh_t個