title	Interface to CRT BIOM Routines for PASCAL
	page	85,132
;
;  COPYRIGHT @ 1982
;	Jim & Eric Holtman
;
include b:struct.mac
prolog	macro		; prolog setup for PASCAL
						push	bp
						mov	bp,sp	; parameters
	endm

epilog	macro	num	; exit of PASCAL procedure
						pop	bp
						ret	num*2
	endm

;
; setup EQU's for access to BIOS
;
bios	equ	int
crt	equ	10H
kbd	equ	16H
lpt	equ	17H
memck	equ	12H
equip	equ	11H

xxgraph segment para public 'code'
	assume	cs:xxgraph

;
; procedure xxmove(x,y : integer)
;
;    MOVE cursor to indicated position
;
	public	xxmove
xxmove	proc	far
	prolog
	mov	dh,[bp+6]	; 'y'
	mov	dl,[bp+8]	; 'x'
	xor	bh,bh		; clear (page 0)
	mov	ah,2		; cursor call
	bios	crt
	epilog	2
xxmove	endp
;
; procedure xxcls
;
;     CLEAR the screen
;
	public	xxcls
xxcls	proc	far
	prolog
	mov	cx,0	; clear entire window
	mov	dx,(24*256)+79
	mov	bh,7	; normal attribute
	mov	ax,600h
	bios	crt
	epilog	0
xxcls	endp

;
; function xxinkey(var a : char) : integer
;
;    READ the KEYBOARD
;	 allows the 'extended' ASCII characters to be read.
;
;      a - CHAR to which to return the value
;
;     return values:
;	  0 - no data present
;	  1 - normal ASCII
;	  2 - 'extended' ASCII
;
	public	xxinkey
xxinkey proc	far
	prolog
	mov	bp,[bp+6]	; @ of CHAR
	mov	ah,1		; get 'status' of keyboard
	bios	kbd		; KEYBOARD I/O
	.if	nz		; data present
	    xor   ax,ax 	  ; get the data
	    bios  kbd
	    .if   al e 0	  ; 'extended' ASCII
		mov [bp],ah	    ; store character
		mov ax,2	    ; set the flag
	    .else
		mov [bp],al	    ; normal ASCII
		mov ax,1
	    .endif
	.else
	    xor   ax,ax 	  ; set flag for 'NO DATA'
	.endif
	epilog	1
xxinkey endp
;
; procedure xscurt(type : integer)
;
;     set the type of cursor, where HIGH is start line
;     and LOW is the end line of the cursor.
;	      (range of values is 0-31)
;
	public	xscurt
xscurt	proc	far
	prolog
	mov	cx,[bp+6]	; descriptor
	mov	ah,1		; call #
	bios	crt
	epilog	1
xscurt	endp

;
; procedure xrcurp (var x,y : integer)
;
;      READ CURSOR POSITION -- returns the coords in x&y
;
	public	xrcurp
xrcurp	proc	far
	prolog
	xor	bh,bh		; set to page 0
	mov	ah,3		; call #
	bios	crt
	mov	al,dh		; row (y)
	xor	ah,ah		; zero high order bytes
	mov	si,[bp+6]	; pick up address
	mov	[si],ax 	; store 'y'
	xor	dh,dh		; zero high byte of 'x'
	mov	si,[bp+8]	; address
	mov	[si],dx 	; store 'x'
	epilog	2
xrcurp	endp

;
; procedure xscrlup(numlines,start,end : integer)
;
;     SCROLL UP
;	  numlines - # of lines to move
;	  start    - starting row
;	  end	   - ending row
;
	public	xscrlup
xscrlup proc	far
	prolog
	mov	ch,[bp+8]	; top of window <start,0>
	xor	cl,cl
	mov	dh,[bp+6]	; bottom of window <end,79>
	mov	dl,79
	mov	bh,7		; NORMAL attribute byte
	mov	al,[bp+10]	; numlines
	mov	ah,6		; call #
	bios	crt
	epilog	3
xscrlup endp

;
; procedure xscrldn(numline,start,end : integer)
;
;    SCROLL DOWN
;	 numline - # of lines to move
;	 start	 - starting row
;	 end	 - ending row
;
	public	xscrldn
xscrldn proc	far
	prolog
	mov	ch,[bp+8]	; top of window <start,0>
	xor	cl,cl
	mov	dh,[bp+6]	; bottom of window <end,79>
	mov	dl,79
	mov	bh,7		; NORMAL attribute
	mov	al,[bp+10]	; numline
	mov	ah,7		; call #
	bios	crt
	epilog	3
xscrldn endp

;
; function xrca : integer
;
;     READ CHARACTER and ATTRIBUTE at current position
;
;	  return value LOW = character; HIGH = attribute
;
	public	xrca
xrca	proc	far
	prolog
	xor	bh,bh		; page 0
	mov	ah,8		; call #
	bios	crt
	epilog	0
xrca	endp

;
; procedure xwca(ca,num : integer)
;
;     WRITE CHARACTER and ATTRIBUTE at current position
;	 LOW(ca) = character
;	 HIGH(ca) = attribute
;	 num - # of times to write (normally 1)
;
	public	xwca
xwca	proc	far
	prolog
	xor	bh,bh		; page 0
	mov	cx,[bp+6]	; num
	mov	al,[bp+8]	; character
	mov	bl,[bp+9]	; attribute
	mov	ah,9		; call #
	bios	crt
	epilog	2
xwca	endp

;
; procedure xttywrt(var a : string; attr : integer);
;
;    TTY WRITE function
;	 a - string to be written on the CRT
;
	public	xttywrt
xttywrt proc	far
	prolog
	xor	bh,bh		; page 0
	mov	si,[bp+8]	; address of string
	mov	cx,[bp+10]	; size of string
	cld			; set direction
	.repeat

	    .if <byte ptr [si]> ge 20h
		mov   bl,[bp+6]       ; attribute byte
		push  cx	      ; save since used on call
		mov   cx,1	      ; just write character once
		mov   ax,900h	      ; call# + null byte
		bios  crt
		pop   cx	      ; restore after call
	    .endif

	    lodsb		  ; pickup next character
	    mov   ah,14 	  ; call #
	    bios  crt
	.until loop
	epilog	3		; passed max size + address
xttywrt endp

;
; procedure xlpt1(var a : string);
;
;    PRINT CHARACTER string on PRINTER.
;	a - string to be printed
;
	public	xlpt1
xlpt1	proc	far
	prolog
	mov	si,[bp+6]	; @ of string
	mov	cx,[bp+8]	; size of string
	cld
	xor	dx,dx		; indicate printer 0
	.if	cx e 0		; NULL string; INIT the printer
	    mov     ah,1	  ; INIT code
	    bios    lpt
	    epilog  2		  ; return
	.endif
	.repeat
	    lodsb		  ; pickup character
	    xor   ah,ah 	  ; set code for printing
	    bios  lpt		  ; call printer BIOS routine
	.until	loop
	epilog	2		; return
xlpt1	endp
;
; procedure xfreemem
;
;	returns the value of DS+1000H.
;	  this will be the start of 'free memory'
;
	public	xfreemem
xfreemem proc	far
	mov	ax,ds
	add	ax,1000H
	ret
xfreemem endp
;
; function xmaxmem
;
;	returns the 'top of memory' (maximum address)
;
	public	xmaxmem
xmaxmem proc	far
	push	cx
	bios	memck		; get # of 1K blocks in ax
	mov	cl,6		; convert to 'segment' address
	shl	ax,cl
	pop	cx
	ret
xmaxmem endp

;
; function equipment : word
;
;	returns the 'equipment' that is on the PC. This is defined on
;	page A-67 of the Tech Manual.
;
	public	equipment
equipment proc far
	bios	equip		       ; determine equipment on PC
	ret			       ; returns value in AX from BIOS call
equipment endp

;
; procedure sleep(time:integer)
;
;	sleep for 'time' seconds
;
	public	sleep
sleep	proc	far
	push	bp
	mov	bp,sp			; address parameters
	push	ds
	xor	ax,ax			; setup low core memory
	mov	ds,ax
	mov	bx,ds:[46cH]		; low part of timer
	mov	ax,[bp+6]		; sleep 'time'
	mov	cx,182			; multiply by 18.2
	mul	cx			;    (*182/10)
	mov	cx,10
	div	cx			; result left in AX
	.repeat
	    mov    cx,ds:[46cH] 	; current time
	    sub    cx,bx
	.until ax be cx
	pop	ds
	pop	bp
	ret	2
sleep	endp

;
; function timer : word
;     returns the clock in 1 second ticks
;
	public	timer
timer	proc	far
	push	ds			; setup to address
	xor	ax,ax			; LOW core where the
	mov	ds,ax			; clock is.
	mov	ax,ds:[46CH]		; low order bytes of clock
	mov	cx,10
	mul	cx			; divide the time by 18.2
	mov	cx,182
	div	cx			; result left in AX
	pop	ds
	ret
timer	endp

	public	xxvert,retrace_flag
pas_data segment public 'data'
retrace_flag db 0			; set to false to start
pas_data ends

dgroup	group	pas_data

xxvert	proc	far			; wait for horizontal retrace
	assume	ds:dgroup
	.if	retrace_flag ne 0	; only wait if TRUE
	    xor     ax,ax		    ; address
	    mov     es,ax		    ;	low core
	    mov     dx,es:[463H]	    ; active display card
	    add     dx,6		    ; status port
	    .repeat
		in	al,dx
		test	al,1		    ; wait for LOW
	    .until  z
	    cli 			    ; lock out interrupts
	    .repeat
		in	al,dx
		test	al,1		    ; test for HIGH
	    .until  nz
	    sti
	.endif
	ret
xxvert	endp
	assume	ds:nothing

;
; procedure net_unpack(const source:string; var dest:string)
;			12:size  10:@	    8:size  6:@
;      `unpack' the transmission buffer to `printable' ASCII so it
;		use XMODEM protocol on the NET
;
	public	net_unpack
net_unpack proc far
	prolog
	mov	si,[bp+10]		; @ of source string
	mov	di,[bp+6]		; @ of dest string
	mov	bx,di
	add	bx,[bp+8]		; setup limit of conversion
					; this should be 176
	.repeat
		mov	al,[si]
		shr	al,1
		shr	al,1
		and	al,3FH		; get 1st 6 bits
		or	al,40H		; make ASCII
		mov	[di],al
		mov	ax,[si]
		xchg	al,ah		; get right byte ordering
		mov	cl,4
		shr	ax,cl
		and	al,3FH
		or	al,40H		; make ASCII
		mov	[di+1],al
		mov	ax,[si+1]
		xchg	al,ah
		mov	cl,6
		shr	ax,cl
		and	al,3FH
		or	al,40H
		mov	[di+2],al
		mov	al,[si+2]
		and	al,3FH
		or	al,40H
		mov	[di+3],al
		add	si,3
		add	di,4
	.until di ae bx
	epilog 4
net_unpack endp

;
; procedure net_pack(const source:string; var dest:string)
;		      12:size  10:@	 8:size  6:@
;      `packs' the data that came over the NET for XMODEM
;
	public	net_pack
net_pack proc	far
	prolog
	mov	si,[bp+10]		; @ of source
	mov	di,[bp+6]		; @ of dest
	mov	bx,di
	add	bx,[bp+8]		; ending condition
	.repeat
		mov	ax,[si]
		xchg	al,ah
		shl	al,1		; combine upper 6 bits
		shl	al,1
		shl	ax,1		; with lower 2 bits
		shl	ax,1
		mov	[di],ah 	; for 1st byte
		mov	ah,[si+2]	; AL contains high nibble
		shr	ah,1		; adjust the low nibble
		shr	ah,1
		and	ah,0FH
		or	ah,al		; combine for
		mov	[di+1],ah	;     2nd byte
		mov	ax,[si+2]
		xchg	al,ah
		shl	al,1		; combine the lower 6 bits
		shl	al,1
		shr	ax,1		; with the upper 2 bits
		shr	ax,1
		mov	[di+2],al	; and store as 3rd byte
		add	di,3
		add	si,4
	.until di ae bx
	epilog	4
net_pack endp

xxgraph ends
	end