114 lines
5.0 KiB
NASM
114 lines
5.0 KiB
NASM
; =====> SCROLL.ASM
|
||
;***************************************
|
||
;* TIPC Scheme Runtime Support *
|
||
;* Window Support Routine *
|
||
;* *
|
||
;* (C) Copyright 1985 by Texas *
|
||
;* Instruments Incorporated. *
|
||
;* All rights reserved. *
|
||
;* *
|
||
;* Date Written: October 1985 *
|
||
;* Last Modification: *
|
||
;***************************************
|
||
include pcmake.equ
|
||
|
||
TI_CRT equ 049h
|
||
IBM_CRT equ 010h
|
||
|
||
DGROUP group DATA
|
||
DATA segment word public 'DATA'
|
||
assume DS:DGROUP
|
||
extrn PC_MAKE:word
|
||
DATA ends
|
||
|
||
XGROUP group PROGX
|
||
PROGX segment byte public 'PROGX'
|
||
assume CS:XGROUP,DS:DGROUP
|
||
extrn crt_dsr:far
|
||
|
||
;************************************************************************
|
||
;* Scroll Window Down one line *
|
||
;************************************************************************
|
||
s_args struc
|
||
dw ? ; caller's BP
|
||
dd ? ; return address
|
||
dw ?
|
||
s_line dw ? ; upper left hand corner line number
|
||
s_col dw ? ; upper left hand corner column number
|
||
s_nline dw ? ; number of lines
|
||
s_ncols dw ? ; number of columns
|
||
s_attr dw ? ; text attributes (used for blanking)
|
||
s_args ends
|
||
|
||
scroll%d proc far
|
||
push BP ; save caller's BP
|
||
mov BP,SP
|
||
; scroll window's text down one line
|
||
mov CL,byte ptr [BP].s_nline ; load number of lines
|
||
dec CL ; decrease number of lines by one
|
||
jz blank ; Jump if scrolling 1-line and just blank it
|
||
mov CH,byte ptr [BP].s_ncols ; load number of columns
|
||
mov DL,byte ptr [BP].s_line ; load upper left line number
|
||
mov DH,byte ptr [BP].s_col ; load upper left column number
|
||
mov AX,0701h ; load "scroll text" code with no blanking
|
||
cmp DGROUP:PC_MAKE,TIPC
|
||
je ti_down
|
||
|
||
push AX ; else
|
||
mov AH,0Fh
|
||
int IBM_CRT ; Are we in graphics mode?
|
||
cmp AL,4 ; If we are then fix blank fill attributes
|
||
jl text_m ; so that the bar characters don't show up
|
||
cmp AL,7
|
||
je text_m
|
||
xor BH,BH ; zero attribute for fill blanks
|
||
jmp short wrte_atr
|
||
text_m: mov BH,byte ptr [BP].s_attr ; Blanked lines' attribute txt mode
|
||
|
||
wrte_atr: pop AX
|
||
xchg CX,DX ; CX=Upper left corner
|
||
xchg CH,CL ; Row,column instead of TI's column,row
|
||
xchg DH,DL ; ditto
|
||
add DX,CX ; DX=Lower right corner
|
||
dec DL ; adjust column count (0 is first column)
|
||
int IBM_CRT
|
||
jmp short quit ; IFF IBM is in graphics mode weird char's
|
||
; are used for blanks when scrolling. Do
|
||
; as TIPC does and "manual" blank 'em.
|
||
;
|
||
ti_down: mov BX,DX ; copy destination coordinates
|
||
inc BL ; compute dest by incrementing line number
|
||
int TI_CRT ; perform the block move
|
||
; paint the first line of the window with blank of proper attributes
|
||
blank: mov DH,byte ptr [BP].s_col ; load starting column number
|
||
mov DL,byte ptr [BP].s_line ; load upper line number
|
||
mov AH,02h ; load the "put cursor" code
|
||
xor BH,BH ; IBMism
|
||
call crt_dsr ; position cursor for write
|
||
mov AX,0920h ; load "write char/attr" code, write a blank
|
||
mov BL,byte ptr [BP].s_attr ; load attribute bit setting
|
||
xor BH,BH ; IBMism
|
||
mov CX,[BP].s_ncols ; load line length
|
||
call crt_dsr ; write a line of blanks
|
||
; return to caller
|
||
quit: pop BP ; restore caller's BP
|
||
ret
|
||
scroll%d endp
|
||
PROGX ends
|
||
|
||
;****************************************************************************
|
||
;* Link routine *
|
||
;****************************************************************************
|
||
|
||
PGROUP GROUP PROG
|
||
PROG SEGMENT BYTE PUBLIC 'PROG'
|
||
assume CS:PGROUP
|
||
public scroll_d
|
||
|
||
scroll_d proc near
|
||
call scroll%d ; link to window scroll down routine
|
||
ret
|
||
scroll_d endp
|
||
PROG ends
|
||
end
|
||
|