.286
  w equ word ptr
  b equ byte ptr
data segment public
  extrn vscreen:dword
  extrn vpage:word
  extrn palette:dataptr
data ends


code segment public
assume cs:code,ds:data
public init_modex, p13_2_modex, squeeze, copyscreen, double
public clrx, split, setpal, getpal, switch, setstart, enter400
public waitretrace, fade_out, fade_to, copy_block, pal_rot

switch proc far                 ;switches between both video pages
  mov bx,vpage                  ;load start address
  mov dx,3d4h
  mov al,0ch                    ;distribute to CRTC register 0dh/0ch
  mov ah,bh
  out dx,ax                     ;set highbyte (register 0dh)
  inc al
  mov ah,bl
  out dx,ax                     ;set lowbyte (register 0ch)
  cmp bx,16000d                 ;switch start address (0/16000)
  je set0
  mov vpage,16000
  ret
set0:
  mov vpage,0
  ret
switch endp

Init_ModeX proc pascal far      ;enables Mode X
  mov ax,0013h                  ;set Mode 13h
  int 10h

  mov dx,3c4h                   ;timing sequencer
  mov al,4                      ;register 4 (memory mode):
  out dx,al                     ;clear bit 3 -> chain4 off
  inc dx
  in al,dx
  and al,0f7h
  or al,4h                      ;set bit 2 -> odd/even mode off
  out dx,al
  dec dx

  mov ax,0f02h                  ;register 2 (write plane mask):
  out dx,ax                     ;0fh: all planes on during write
  mov ax,0a000h                 ;clear video RAM
  mov es,ax
  xor di,di
  xor ax,ax
  mov cx,0ffffh
  cld
  rep stosw

  mov dx,3d4h                   ;CRTC
  mov al,14h                    ;register 14h  (underline row address):
  out dx,al
  inc dx
  in al,dx                      ;clear bit 6 -> doubleword address off
  and al,0bfh
  out dx,al
  dec dx
  mov al,17h                    ;register 17h (CRTC mode):
  out dx,al                     ;set bit 6 -> byte mode on
  inc dx
  in al,dx
  or al,40h
  out dx,al
  ret
Endp

Enter400 proc pascal far        ;switches from mode X (200 rows)
  mov dx,3d4h                   ;to extended 400 row mode
  mov al,9                      ;CRTC register 9 (maximum row address)
  out dx,al                     ;select
  inc dx                        ;read out value 2
  in al,dx
  and al,01110000b              ;clear bits 7 and 3:0
  out dx,al                     ;and write back
  ret
Enter400 endp

plane_l: db 0
plane_pos: dw 0

p13_2_modex proc pascal far start,pic_size:word
    mov dx,03ceh                ;set write mode 0
    mov ax,4005h                ;via GDC register 5 (GDC mode)
    out dx,ax

    mov b plane_l,1             ;store plane mask
    push ds
    lds si,dword ptr ds:vscreen ;load source address
    mov w plane_pos,si          ;and store
    mov ax,0a000h               ;set destination address
    mov es,ax
    mov di,start
    mov cx,pic_size             ;get number
@lpplane:
    mov al,02h                  ;TS register 2 (write plane mask)
    mov ah,b plane_l            ;mask corresponding plane
    mov dx,3c4h
    out dx,ax

  @lp1:
    movsb                       ;copy byte
    add si,3                    ;position at next source byte
    loop @lp1

    mov di,start                ;get destination address again
    inc w plane_pos             ;source address to new start
    mov si,w plane_pos
    mov cx,pic_size             ;get size
    shl b plane_l,1             ;mask next plane
    cmp b plane_l,10h           ;all 4 planes copied ?
    jne @lpplane

    pop ds
    ret
Endp
Split proc pascal far row:byte  ;screen splitting in "row" row
  mov bl,row
  xor bh,bh
  shl bx,1                      ;*2 because of row duplication
  mov cx,bx

  mov dx,3d4h                   ;CRTC
  mov al,07h                    ;register 7 (overflow low)
  out dx,al
  inc dx
  in al,dx
  and al,11101111b              ;load bit 4 with bit 8 of the row
  shr cx,4
  and cl,16
  or al,cl
  out dx,al                     ;and set

  dec dx
  mov al,09h                    ;register 9 (maximum row address)
  out dx,al
  inc dx
  in al,dx
  and al,10111111b              ;load bit 6 with bit 9 of the row
  shr bl,3
  and bl,64
  or al,bl
  out dx,al                     ;and set

  dec dx
  mov al,18h                    ;register 18h (line compare/split screen)
  mov ah,row                    ;set remaining 8 bits
  shl ah,1
  out dx,ax
  ret
Endp
SetStart proc pascal far t:word ;sets screen start to specified address
  mov dx,3d4h                   ;CRTC
  mov al,0ch                    ;register 0ch(linear starting address middle)
  mov ah,byte ptr t + 1         ;set bits 15:8
  out dx,ax                     ;register 0dh(LSA low)
  mov al,0dh                    ;set bits 7:0
  mov ah,byte ptr t
  out dx,ax
  ret
Endp
WaitRetrace proc pascal far
  mov dx,3dah                   ;input status register 1
@wait1:
  in al,dx                      ;bit 3 becomes 0 when beam busy redrawing image
  test al,08h
  jnz @wait1
@wait2:
  in al,dx                      ;bit 3 becomes 1 when retrace
  test al,08h
  jz @wait2
  ret                           ;now the beam is at the bottom of the screen
Endp
public squeeze
squeeze proc pascal far         ;squeezes screen together
  mov si,200*80                 ;initial value for start address
  mov di,199                    ;initial value for split row
sqlp:                           ;main loop
  call waitretrace              ;wait for retrace
  call split pascal, di         ;set lower half by splitting
  call setstart pascal, si      ;set upper half by scrolling
  sub si,80                     ;one row further, so go down
  dec di                        ;split one row down, so
  cmp di,99d                    ;move lower half up
  jae sqlp                      ;finished ?
  ret
squeeze endp
clrx proc pascal far pmask:byte ;clears mode X - pages
  mov al,02h
  mov ah,pmask
  mov dx,3c4h
  out dx,ax
  mov ax,0a000h                 ;get start address and length
  mov es,ax
  mov di,vpage
  xor ax,ax
  mov cx,8000
  rep  stosw                    ;and clear
  ret
clrx endp
copyscreen proc pascal far destination,source:word
  mov dx,3c4h   		;select all planes
  mov ax,0f02h
  out dx,ax
  mov dx,3ceh                   ;write-mode 1 (copy)
  mov ax,4105h
  out dx,ax

  push ds
  mov ax,0a000h									;source and destination segment in VGA
  mov es,ax
  mov ds,ax
  mov si,source                 ;load source and destination offset
  mov di,destination
  mov cx,16000d                 ;copy 16000 bytes (=64000 pixels)
  rep movsb
  pop ds
  mov dx,3ceh                   ;write-mode 0
  mov ax,4005h
  out dx,ax
  ret
copyscreen endp
SetPal proc pascal far
  push si
  mov si,offset palette         ;get address
  mov cx,256*3                  ;get number of colors
  xor al,al
  mov dx,03c8h                  ;external palette RAM, pixel write address
  out dx,al                     ;set from color 0
  inc dx                        ;pixel color value

  rep outsb                     ;send all colors to VGA
  pop si
  ret
Endp

getpal proc pascal far
  push di
  mov di,offset palette         ;get address
  mov cx,256*3                  ;get number of colors
  xor al,al
  mov dx,03c7h                  ;external palette RAM, pixel read address
  out dx,al                     ;read from color 0
  mov dx,3c9h                   ;pixel color value

  rep insb                      ;send all colors to VGA
  pop di
  ret
Endp

double proc pascal far
  mov dx,3d4h                   ;CRTC register 13h (row offset)
  mov ax,5013h                  ;set to 80 (double width1)
  out dx,ax                     ;and write
  ret
double endp


fade_out proc pascal far        ;fades out image, video-mode independent
local greatest:word             ;contains maximum possible color value
  mov greatest,63
  mov ax,ds                     ;load destination segment
  mov es,ax
main_loop:                      ;main loop, run once per image
  lea si,palette                ;source and destination offset to palette
  mov di,si
  mov cx,768                    ;modify 768 bytes
lp:
  lodsb                         ;get value
  dec al                        ;decrement
  jns set                       ;if not yet negative -> set
  xor al,al                     ;otherwise 0
set:
  stosb                         ;write destination value in "palette"

  dec cx                        ;loop counter
  jne lp

  call waitretrace              ;synchronize to retrace
  call setpal                   ;set calculated palette
  dec greatest                  ;decrement outer loop
  jne main_loop                 ;still not finished ? then continue

  ret
fade_out endp


fade_to proc pascal far destinationpal:dword, length1:word, step:byte
;fades "palette" to "destinationpal", passed by Pascal as array of byte !
local greatest:word
  mov ax,63                     ;calculate number of passes
  div step                      ;necessary to reach 63
  xor ah,ah
  mov greatest,ax               ;set number of loop passes
next_frame:
  les di,destinationpal         ;get offset holen, Pascal passes arrays far !
  lea si,palette                ;get offset of "palette"
  mov cx,768                    ;process 768 bytes

continue:
  mov al,[si]                   ;get value from current palette
  mov ah,[di]                   ;get value from destinationpal

  mov bl,ah
  sub bl,al                     ;difference to destination value
  cmp bl,step                   ;more than one step over ?
  jg up                         ;-> decrement
  neg bl                        ;difference
  cmp bl,step                   ;greater than negative step
  jg down

  mov al,ah                     ;destination reached, finally set

write:
  dec cx                        ;decrement color loop
  je finished                   ;0 ? -> finished
  mov [si],al                   ;write value in palette
  inc si                        ;select next value
  inc di
  jmp continue                  ;and continue
down:
  sub al,step                   ;decrement
  jmp write
up:
  add al,step                   ;increment
  jmp write
finished:                       ;palette calculated
  call waitretrace              ;synchronization
  call setpal                   ;set palette
  dec greatest                  ;all 63 passes finished ?
  jne next_frame                ;no -> continue

  ret
fade_to endp

copy_block proc pascal far destination,source,width1,height1:word
local jump:word
  mov dx,3ceh                   ;GDC
  mov ax,4105h                  ;readmode 0, writemode 1
  out dx,ax                     ;on register 5 : GDC mode
  mov dx,3c4h                   ;TS
  mov ax,0f02h                  ;enable all planes
  out dx,ax                     ;on register 2 : write plane mask

  push ds
  mov ax,0a000h                 ;copy within VGA
  mov es,ax                     ;-> both segments to 0a000h
  mov ds,ax
  mov si,source                 ;source data from source
  mov di,destination            ;copy to destination
  mov dx,height1                ;copy high rows

  mov ax,80                     ;calculate jump between two rows
  sub ax,width1                 ;(= 80-width1)
  mov jump,ax

line_lp:
  mov cx,width1                 ;load width1
  rep movsb                     ;copy a line
  add si,jump
  add di,jump

  dec dx                        ;continue line counter
  jne line_lp

  pop ds
  ret
copy_block endp

Pal_Rot proc pascal far Start,End1:Word
                                ;rotates palette part by 1 from start to end1
                                ;if start < end1 : rotation down
                                ;if start > end1 : rotation up

  mov ax,ds                     ;es to data segment
  mov es,ax

  lea si,palette                ;set palette offset
  mov di,si                     ;also to di

  mov ax,3                      ;convert "start" to palette offset  '
  mul start
  add si,ax                     ;and add to si
  mov ax,3                      ;same for destination
  mul end1
  add di,ax                     ;add to di

  mov bx,[si]                   ;store bytes of start color
  mov dl,[si+2]

  mov cx,di                     ;difference between start and end is number
  sub cx,si                     ;bytes to be copied

  mov di,si                     ;start color as destination offset
  add si,3                      ;one color above as source offset
                                ;ready for forward copying
  cld                           ;default: forward copy
  or cx,cx                      ;if cx negative (start > end1)
  jns forward
  std                           ;then backwards copy
  neg cx                        ;correct cx
  sub si,4                      ;si to 2nd byte of penultimate color
  add di,2                      ;di to 2nd byte of last color
  add cx,2                      ;copy 2 bytes more,
forward:                        ;so that position is correct after copy loop

  rep movsb                     ;copy colors
  mov [di],bx                   ;bytes of old start color
  mov [di+2],dl                 ;write as last color

  cld                           ;clear direction-flag again
  ret
Pal_Rot Endp

code ends
end
