; ATI card initialization from colorForth
code 'vesa', vesa
	call dev
        or dword [eax-4],2
        add al,24h-8
        mov cl,5
.1      dup
        call north
        xor al,8
        jz .2
        drop
        sub eax,byte 4
        loop .1
        dup
        call north
        and eax,0FFFFFFF0h
.2      mov dword [frame],eax
        drop
        embed '640 480 setres'
        ret

dev:    mov eax,80001008h
        mov ecx,31-1
.1      dup
        call north
        and eax,0FF000000h
        cmp eax,  3000000h
        drop
        jz .2
        add eax,800h
        loop .1
.2      ret

north:  mov edx,0CF8h
        out dx,eax
        add dl,4
        in eax,dx
        ret

;---------------------------------------------------------------
code 'at', $at
   shl eax, 16
   call $plus
   mov dword [xy], eax
   drop
next
;---------------------------------------------------------------
;BLIT - Copy a rectangle to (x,y)
;	( w h x y -- )
code 'blit', blit
	push edx
	push edi
	call clip	;current position in ESI (temporarily in EDX)
	mov edx,edi
	call $at	;new position in EDI
	call clip
	upop ecx	;width in EAX, height in ECX
	xchg esi,edx
.1	  push ecx
	  mov ecx,eax
	  rep movsb
	  mov ecx,dword [hp]
	  sub ecx,eax
	  add esi,ecx
	  add edi,ecx
	  pop ecx
	  loop .1
	xchg esi,edx
	pop edi
	pop edx
	drop
next
;---------------------------------------------------------------
clip:
	mov edi,[xy]
	mov ecx,edi
	test cx,cx
	jns .1
	xor ecx,ecx
.1	and ecx,0xffff
	imul ecx,dword [hp]		;320*2 for 16-bit gfx
	sar edi,16
	jns .2
	xor edi,edi
.2	lea edi,[edi+ecx]	;edi*2 for 16-bit
      add edi,dword [frame]
next
;---------------------------------------------------------------
code 'cr', cr
	push ecx
        xor ecx,ecx     ;x=0
	mov cx,[xy]
	add cx,ih	;y=y+ih
	mov [xy],ecx
      add ecx,8
.scroll cmp cx,[vp]
        js .1
        pusha
        embed 'scroll'
        popa
.1      pop ecx
.2      ret
?cr:    push ecx
        mov cx,[xy+2]   ;x
        cmp cx,[hp]
        pop ecx
        js cr.2
        jmp cr
;---------------------------------------------------------------
code 'emit', emit
	push esi			; emit
	push edi			;  Store a few registers
	push ecx
	push edx
	call ?cr			;  Wrap to a new line?
.0	and eax,0xff			;  Filter byte
	imul eax,ih*iw/8		;  byte/char in FONT
	lea esi,[font+eax]		;  Load byte from FONT
	call clip			;  Clip the drawing region
	mov edx,[fore] 			;  color (2 = green)
	mov ecx,ih		;  Height of character
.line	push ecx			;  Store height
	lodsb			 	;  al=font line
	mov ecx,iw			;  Width of character
.pix	shl al,1			;  Begin drawing the character
	jnc .1
	mov [edi],dl			;  Store a pixel
.1	inc edi
	loop .pix			;  Is this line done?
	add edi,dword [hp]
      sub edi, iw			;  Yes? Then do next line
	pop ecx				;  Restore height/width
	loop .line			;  Are we done?
	pop edx				;  Yes!
	pop ecx				;  Restore the registers
	pop edi
	pop esi
	drop				; drop the character from stack
      add [xy],dword (iw<<16)		; And advance one space
next
;---------------------------------------------------------------
; ( KEY, a generic keyboard driver )
code 'key', key
	dup				; key
	  xor eax,eax		;  clear eax
.1      in al,64h       	;  Is any data waiting?
	  test al,1			;  Is character = ASCII 0?
	  jz .1			;  Yes? Try again
        in al,60h       	;  Otherwise, read scancode
        xor edx,edx		;  edx: 0=make, 1=break
        test al,80h		;  Is character = HEX 80h?
        jz .2			;  Skip the next line
        inc edx			;  Update edx
.2      and al,7Fh		;  Filters to handle
        cmp al,39h      	;  the ignored keys
	  ja .1			;  We just try another key
        mov ecx,[board]		;  Load the keymap
        mov al,[ecx+eax]	;  Get the key ASCII char
	  or al,al			;  Is is = 0?
        js .shift			;  No, use CAPITALS
        jz .1  			;  Ignore 0's
        or dl,dl			;  Filter for break code
        jnz .1 			;  Ignore break code
 	  ret
.shift  mov ecx,[edx*4 + .shifts]	;  Load the CAPITAL keymap
        mov [board],ecx			;  Store into BOARD pointer
        jmp short .1			;  And try again
.shifts dd shift,alpha
variable board, alpha
alpha:
  db 0,27,"1234567890-=",8              ;00-0E
  db 9,"qwertyuiop[]",10                ;0F-1C
  db 0,"asdfghjkl;'`"                   ;1D-29
  db -1,"\zxcvbnm,./",-1,"*",0,32,-2    ;2A-3A
shift:
  db 0,27,"!@#$%^&*()_+",8              ;00-0E
  db 9,"QWERTYUIOP{}",10                ;0F-1C
  db 0,'ASDFGHJKL:"~'                   ;1D-29
  db -1,"|ZXCVBNM<>?",-1,"*",0,32,-2    ;2A-3A
;---------------------------------------------------------------
code 'rect', rect
	push ecx
	push edx
	push edi
	call clip
	upop ecx		  ;h
	mov edx,eax		  ;w
      mov eax,dword [fore]           ;color
.1	push ecx
        mov ecx,edx		  ;w
	rep stosb
	add edi,dword [hp]
	sub edi,edx
	pop ecx
	loop .1
	pop edi
	pop edx
	pop ecx
	drop
next

code 'iol@', inl_fetch
   upop edx
   in eax, dx
next
code 'iol!', iol_store
   upop edx
   out dx, eax
next

; ---------------------------------------------------
; Graphical Settings
; ---------------------------------------------------
ih equ 8                       ; Font height
iw equ 8                       ; Font width
var 'color', fore, 0           ; Foreground (text) color
var 'xy', xy, 0                ; Starting X,Y position
var 'hp', hp, 640              ; Screen Width (pixels)
var 'vp', vp, 480              ; Screen Height (pixels)
var 'hc', hc, 640/iw           ; Screen Width (characters)
var 'vc', vc, 480/ih           ; Screen Height (characters)
var 'frame', frame, 0xA0000    ; Address of video RAM

section .data
font: incbin "font"   ; Pathname to the font file
section .text
