; Pyrit

; a 256-byte intro by Rrrola <rrrola@gmail.com>

; greets to everyone who's computer is too fast :)

; This is loosely based on my intro 'Gem' (shown on Demobit),
; but the code is much better.

; Vector3: X right, Y down, Z forward.
; On the FP stack it looks like {Y X Z} (Y is often used in comparisons).
; In memory it looks like {Z X Y}, which saves a displacement byte.
; (u'v) is the dot product: ux*vx + uy*vy + uz*vz.

        org 0x7c00
        xor ax,ax
        xor bx,bx
        mov cx,0ffh
        mov di,-2
;        mov ss,dx
        mov sp,di
        mov si,100h
        mov bp,091ch

; assume al=0 bx=0 sp=di=-2 si=0100h bp=09??h

;Set video mode and earth+sky palette
  dec di       ; u16[100h] = -20401, u16[10Ch] = -30515
  mov al,13h
  dec di       ; initial pixel_adr@di = -4

P:shr cl,1     ; B@cl = 0..8..31,31..0

  int 10h      ; set video mode / color: bx=index dh=R ch=G cl=B

  movsx cx,bl  ; 0..127,128..255 (palette index)
  xor ch,cl    ; 0..127,127..0
  mov cl,ch
  mov ax,cx
  mul ax       ; R@dh = 0..16..63,63..16..0

  shr cx,1     ; G@ch = 0..63,63..0

  inc bl       ; keep default color 0
  js Q         ; R@dh = 0..63,63..16..0
  xchg cl,dh   ; B@cl = 0..16..63,63..0
Q:mov ax,1010h
  jnz P        ;bx=0 cx=0

        ; Constants expected at a fixed address below.
        mov ax,0b04fh
        mov word[100h],ax
        mov ax,04f13h
        mov word[102h],ax
        mov ax,0e9d0h
        mov word[104h],ax
        mov ax,010cdh
        mov word[106h],ax
        mov ax,0be0fh
        mov word[108h],ax
        mov ax,030cbh
        mov word[10ah],ax
        mov ax,088cdh
        mov word[10ch],ax
        mov ax,089e9h
        mov word[10eh],ax

;Each frame: Generate normals to p0..p11=[bp+200h,300h,...].
M:mov ax,0x4731 ; highest 9 bits: float32 exponent 1/256 (for T)
                ; lower byte = 2*number of rotations+1
                ; lowest 4 bits must be 0x1 for 'test cl,al'
  mov dx,0xA000-10-20-20-4
  mov es,dx    ; dx:bx = YX:XX = 0x9fca:0
  pusha  ; adr:   -18 -16 -14 -12 -10  -8  -6  -4  -2
         ; stack:  di  si  bp  sp  bx  dx  cx  ax   0
         ; data:   -4 100 9??  -2  0  9fca {T/256}
  mov cx,12
G:add bp,si    ; i@cx = 12...1; bp points to p[12-i]; carry=0
  pusha

;Generate 12 planes with unit normals.

;  fld1         ; platonic dodecahedron: exact is atan((1+sqrt5)/2)=1.017rad
  fld dword[di-2]    ;|t=T/256: morphing shape: cube, platonic12, rhombic12

  fsincos

  fldz               ;|a=0 b c (a*a+b*b+c*c = 1)
;  fldlg2 ;irregular shape

N:test cl,al ;=1     ;|a b c
  jnz K
  fchs
K:fstp st3           ;|b c +-a (scramble so that all 12 planes are generated)
  loop N  ;cl=0      ;|z x y

;Do a bunch of slow rotations. z x y -> cx-sy cy+sx z

R:fstp st3           ;|x y z
Z:fld st1            ;|y x y z                     ;|x sy x cy z
  fld dword[di-2]    ;|t=T/256
  fsincos            ;|c=cos(t) s=sin(t) y x y z   ;|c s x sy x cy z
  fmulp st4          ;|s y x cy z                  ;|s x sy cx cy z
  fmulp              ;|sy x cy z                   ;|sx sy cx cy z
  add al,0x7F ; loop 2x
  jo Z
  faddp st3          ;|sy cx cy+sx z
  fsubp              ;|new.z=cx-sy .x=cy+sx .y=z
  jc R       ; loop 24x

S:fstp dword[bp+si] ;[bp+100]=.z [bp+104]=.x [bp+108]=.y
  sub si,di
  jpo S

  popa
  loop G
  popa

; the visible pixels are A0000..AF9FF, I want X=0 Y=0 in the center
;Each pixel: cx=T dx:bx=YX:XX(init=9fca:0) di=adr(init=-4)
X:inc dx       ; part of "dx:bx += 0x0000CCCD"
X2:
  stosb

  pusha        ; adr:     -18 -16 -14 -12 -10  -8  -6  -4  -2
  fninit       ; stack:    di  si  bp  sp  bx  dx  cx  ax   0
  mov bx,es    ; s16:  pixadr 100 9??  -2  ..X..Y  T result
  mov di,-4 ;di = address of pushed ax

;Compute ray direction.
  fild word[BIG] ; store 28799 as a double, read as two floats
  fst qword[bx]     ; t_front@float[bx] = 0, t_back@float[bx+4] = 6.879
  fild word[di+4-9]
  fild word[di+4-8]  ;|y=Y x=X z=BIG

;Intersect the pyrite.
  call GEM
  popa         ; color -> pushed ax
;  mov al,dl    ; show only palette

;; Faster, but lower quality: draw each pixel twice.
;  stosb
;  add bx,0xCCCD; dx:bx = YXX += 0000CCCD
;  adc dx,0

  add bx,0xCCCD; dx:bx = YXX += 0000CCCD
  jnc X2
  jnz X        ; do 65536 pixels

  in al,60h
  dec ax  ; ah=0 (checkboard uses positive color indices)
  loopnz M        ; T--
;  ret          ; fallthrough

GEM:
;Hit the pyrite.
  xchg ax,cx   ; ax = T

; Faster (+4 or +8 bytes): test the shape only in the center of the screen
  add dh,dh
  jo B
  add dl,dl
  jo B

;Ray-plane intersection.
;Find the front plane with maximum t and back plane with minimum t.
; tf@[bx],    tb@[bx+4]      ray parameter t
; pf@[bx+si], pb@[bx+4+si]   pointer to plane
  mov cx,12  ; i@cx = 12...1
I:add bp,si    ; bp points to p[i]
  fldlg2             ;|pd=0.301 y x z
  fadd dword[bp+si]  ;|N=pd-(ro'p[i]) y x z  ; ro = 0 0 -1

  push si      ; Dot product:
D:fld dword[bp+si]   ;|p[i].z ...
  fmul st4           ;|rd.z*p[i].z ...
  sub si,di    ; 100 104 108
  jpo D              ;|(rd*p[i]).y .x .z N rd.y .x .z
  pop si
  faddp
  faddp              ;|D=(rd'p[i]) N y x z

;If we hit the plane from the front (D<0), update tf. Otherwise update tb.
  push bx
  fst dword[bp+di]; -> p[i].dot_rd (will be read later)
  test [bp+di+2],sp ; sf=1 if we're in front of the plane
  js FRONT
  sub bx,di    ; bx = address of tf?tb
FRONT:         ; D<0:  if tf*D < N { tf=N/D; pf=current; }  maximalize tf
  fld st0      ; D>=0: if tb*D < N { tb=N/D; pb=current; }  minimalize tb
  fmul dword[bx]     ;|(tf?tb)*D D N y x z

;;DosBOX-compatible FPU comparison, +5 bytes (+3 but we need ax)
;  push ax
;  fcomp st2          ;|D N y x z
;  fnstsw ax
;  sahf         ; cf = (tf?tb)*D < N
;  pop ax
;  jc NEXT

  fcomip st2
  jc NEXT

;another alternative, +6 bytes
;  fsub st2
;  fstp dword[bp-8]
;  test [bp-6],sp ; sf=1 if <0
;  js NEXT


  fdivr st1          ;|t=N/D N y x z
  fst dword[bx] ; -> tf?tb
  mov [bx+si],bp ; pf?pb = current
NEXT:
  fcompp
  pop bx             ;|y x z

  mov dx,[bx+6]
  cmp dx,[bx+2]  ; if tf>tb { no_hit: early exit }
  jng B     ;si=100   ;|y x z

  loop I

;Reflect: reflect(i,n) = i - 2*n*(i'n)
  mov bx,[bx+si] ; pf
Y:fld dword[bx+di]   ;|(rd'pf) rd.y .x .z  ; reads pf->dot_rd
  fmul dword[bx+si]  ;|(rd'pf)*pf.z rd.y .x .z
  fadd st0           ;|2*(rd'pf)*pf.z rd.y .x .z
  fsubr st3          ;|R.z=rd.z-2*(rd'pf)*pf.z rd.y .x .z
  sub si,di   ;100 104 108
  jpo Y     ;si=10C  ;|(R=i-2*n(i'n)).y R.x R.z rd.y .x .z

;Environment map: chessboard below, sky gradient above.
B:
; Subtle highlight on the pyrite.
  fld st0
  fimul word[C]  ; 16993 (background) or 20036 (pyrit)
  fistp dword[di]     ;|y x z
  sar dword[di],22    ; if y>=-0.5 { chessboard } else { sky }
  js E             ; the sky is just y (= y^2 after gamma)

; Everything the same brightness. (-6 bytes)
;  fist word[di]      ;|y x z
;  sar word[di],8  ; if y>=-0.5 { chessboard } else { sky }
;  js E            ; the sky is just y (= y^2 after gamma)

; Dark background version.
;  fist word[di]      ;|y x z
;  shld cx,si,16-3
;  xor cl,9        ; hit?8:9 - make the background darker
;  sar word[di],cl ; if y>=-0.5 { chessboard } else { sky }
;  js E            ; the sky is just y (= y^2 after gamma)

  fidivr word[si]    ;|C/y x z (C = hit?-30515:-20401)
  fmul st1,st0
  fmul st2           ;|u=z*C/y v=x*C/y z

  fistp dword[bp+di]
  sub al,[bp+di+1]
  fistp dword[bp+di]
  xor al,[bp+di+1] ; xortex@ax = (T-u) XOR v

;  aam -32-24     ; more interesting floor texture
  and al,9<<3
  add al,10<<3    ; tex = (xortex AND 0b1001) + 10 [10|11|18|19]
  mul byte[di]
  mov [di],ah     ; pushed al = tex*y

E:ret

BIG     dw 28799
C       dw 16993
C2      dw 20036

        times 510-($-$$) db 0
        db 0x55,0xaa