head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.37.17;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.12.49;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.42.53;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.21.06;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.25.23;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.26.36;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.10.33;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.10.05;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.24.58;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.09.15;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.15.18;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.57.01;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.44.13;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.51.50;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.09.13;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.00.36;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.45.10;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.28.06;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.50.04;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.34.28;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.26.03;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.38.38;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.17.10;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.31.10;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.06.23;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.39.08;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.46.51;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.08.07;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.45.24;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.30.05;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.57.44;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.28.29;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.09.50;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.26.14;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.09.45.07;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.22.04;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.07.22;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.50.36;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.03.53;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.19.42;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.15.56;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.30.33;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.15.43.08;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.17.03;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.20.19;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.28.57;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.19.10;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.45.17;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.52.52;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.14.32.11;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.50.30;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.40.29;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.17.51.23;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.39.34;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.41.59;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.52.53;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.38.42;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.14.45.24;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@	     page
*
*   GATOR bit-mapped alpha driver
*
*     Pascal 3.0 version by J. Schmidt
*
	 def     cscrollup,cscrolldown,cupdatecursor,cchar,cclear
	 def     cbuildtable,cshiftleft,cshiftright
	 def     cexchange,cscrollwindow,changecursor
	 def     cscrollwinddn,cdbscrolll,cdbscrollr,cdbhighl
	 rorg.l 0
	 refa    crtb,sysdevs
	 nosyms

clearl   equ     $CC000     blank pixel row offset

maxx     equ     crtb-10
maxy     equ     crtb-12
cursoraddr equ    crtb-4
highlight equ    crtb-18
controladdr equ  sysdevs-86
screen   equ     sysdevs-90
replcopy equ     sysdevs-92
windcopy equ     sysdevs-94

replreg  equ     $4008
windreg  equ     $400c
status   equ     $4001

width        equ     1024
initoffset   equ      $23                   offset to initialization offset
fontoffset   equ      $3B                   offset to font info offset

*   gbuildtable(ptr);

cbuildtable movea.l (sp)+,a4  a4 = return address
	    movea.l  controladdr(a5),a0    get pointer to ROM start
	    moveq    #0,d0
	    moveq    #0,d1
	    move.b   status(a0),d0           get status reg again
	    lsr.b    #2,d0                  get monitor type bits
	    and.b    #12,d0
	    move.b   initoffset(a0,d0.w),d1  get MSB of info addr offset
	    lsl.w    #8,d1
	    move.b   initoffset+2(a0,d0.w),d1  get LSB of info addr offset
	    movea.l  a0,a1                  make copy of ROM start addr
	    adda     d1,a1                  a1 points to init info now
ginitblock  moveq    #0,d1                  clear some regs
	    moveq    #0,d0
	    move.b   2(a1),d0               get word count to initialize
	    movep    4(a1),d1               form destination offset
	    add.l    a0,d1                  d1 points to dest addr
	    lea      8(a1),a2               a2 points to first data byte
	    movea.l  d1,a3                  a3 points to destination
ginitloop   movep    0(a2),d1                form a data word in d1
	    move.w   d1,(a3)+               move data to the destination addr
	    btst     #6,(a1)                increment data pointer
	    bne.s    ginit1                 based on control byte
	    addq     #4,a2
ginit1      dbra     d0,ginitloop           loop till word count exhausted
	    btst     #7,(a1)                was this last block?
	    bne.s    ginitdone              yes -- go return
	    btst     #6,(a1)                adjust data pointer
	    beq.s    ginit2                 to point to next init block
	    addq     #4,a2
ginit2      movea.l  a2,a1                  a1 points to new init block
	    bra      ginitblock             do the initialize
ginitdone   move.w  #128,replreg(a0)  set repl rule to clear
	    move.w  #0,windreg(a0)
	    moveq   #0,d0
	    move.b  status(a0),d0
	    and     #15,d0               get frame buffer location
	    moveq   #20,d1
	    lsl.l   d1,d0               put it in right place
	    move.l  d0,screen(a5)
	    movea.l d0,a1               clear the whole frame buffer
	    move    #1019,d0              except last 4 pixel lines
zloop       move.b  #00,(a1)
	    adda.l  #width,a1
zcheck      btst    #7,status(a0)
	    beq     zcheck
	    dbra    d0,zloop
	    move    #3,replreg(a0)
	    move    #3,replcopy(a5)
	    clr     windcopy(a5)
	    movep   fontoffset(a0),d1     get font info offset
	    lea     2(a0,d1.w),a1         point to font id code
	    moveq   #2,d7                 count number of font found with d7
fontidchk   movep   2(a1),d2              get offset of font info
	    lea     10(a0,d2.w),a3        a3 points to first char of font
	    cmpi.b  #1,(a1)               is font = roman8 ?
	    beq.s   unpkroman             if so go unpack it
	    cmpi.b  #2,(a1)               is font = kana8 upper half?
	    beq.s   unpkkana              if so go unpack it
nextfont    addq    #6,a1                 point to next font id
	    tst     d7                    have we found both fonts?
	    bne     fontidchk             if not look at this one
	    move.l  screen(a5),cursoraddr(a5)  initialize cursor location
	    bsr     changecursor          turn it on
	    jmp     (a4)                  return

unpkroman   move    #256,d3               #chars to unpack
	    movea.l #$C0000,a2            start at beginning of font storage
unpackit    adda.l  screen(a5),a2
	    subq    #1,d7                 count a found font
	    lsl     #4,d3                 get number of pixel rows to unpack
	    subq    #1,d3
unpackrow   moveq   #7,d4                 we need to look at 8 bits/byte
unpackrow2  btst    d4,(a3)               is bit set in font?
	    sne     (a2)+                 set frame buffer byte accordingly
	    dbra    d4,unpackrow2         loop till all 8 bits done
	    addq    #2,a3                 look at next font byte
	    dbra    d3,unpackrow          and loop till all font rows done
	    bra     nextfont              go look at next font
unpkkana    move    #128,d3               kana8 upper half has 128 chars
	    movea.l #$C8000,a2            store at font storage + 256*128
	    bra     unpackit



* savecrtstate: preserve bit mover  state
*               Entry: d0= replacement rule
*                      d1= window width
*
*               Uses:  a2,a3
*
savecrtstate equ *
	    movea.l controladdr(a5),a3
savestate1  btst   #7,status(a3)    wait for not busy
	    beq    savestate1
	    movea.l (sp)+,a2      save ret addr
	    move   replcopy(a5),-(sp)   save old copy
	    move   windcopy(a5),-(sp)
	    move   d0,replcopy(a5)      setup new values
	    move   d1,windcopy(a5)
	    move   d0,replreg(a3)           setup the registers
	    move   d1,windreg(a3)

	    jmp    (a2)
*
* restcrtstate: restores window width and replacement rule regs
*
*           Uses:  a3
*
restcrtstate equ *
	    movea.l controladdr(a5),a3
restcrt1    btst   #7,status(a3)      wait for not busy
	    beq    restcrt1
	    move   4(sp),windcopy(a5)  restore copy variables
	    move   6(sp),replcopy(a5)
	    move   windcopy(a5),windreg(a3)  restore the registers
	    move   replcopy(a5),replreg(a3)
	    move.l (sp)+,(sp)            move up return addr
	    rts                          and return

*   procedure cchar(ord(char),x,y:shortint);

cchar    movea.l (sp)+,a4
	 move    (sp)+,d0  d0 = y
	 mulu    #16384,d0
	 movea.l d0,a0
	 adda.l  screen(a5),a0
	 move    (sp)+,d5  d5 = x (this will be used later also)
	 lsl     #3,d5
	 adda    d5,a0     a0 = address of byte to begin at
	 movea.l screen(a5),a1    setup font addr in a1
	 adda.l  #$C0000,a1       fonts are just past visible space
	 move    (sp)+,d0  d0 = character
	 mulu    #128,d0
	 lea     0(a1,d0.l),a1  a1 = address of char in font storage
	 move    #width-8,d7
	 move    #3,d0       set repl rule to replace
	 btst    #0,highlight(a5)   inverse video?
	 beq.s   ccharb             if not, skip next instruction
	 move    #12,d0             else set repl rule to invert
ccharb   moveq   #0,d1
	 bsr     savecrtstate
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 btst    #2,highlight(a5)     underline?
	 beq.s   cchar1               no, skip next part
	 bsr     restcrtstate
	 move    #138,d0              setup to invert line 16
	 moveq   #-8,d1
	 bsr     savecrtstate
	 adda    #-8,a0               a0 points to line 16
	 move.b  #0,(a0)              do the invert
cchar1   bsr     restcrtstate
	 jmp     (a4)
*
*
*   cscrollup;
*
*   scrolls the screen up one line of alpha text (16 graphics lines)
*
cscrollup bsr     changecursor
	  movea.l screen(a5),a0
	  movea.l a0,a1
	  adda    #16384,a0
	  move.w  #131,d0
	  moveq   #0,d1
	  bsr     savecrtstate
	  move    maxy(a5),d0
	  subq    #1,d0
suloop2   moveq   #15,d1
suloop    move.b  (a0),(a1)
	  adda    #width,a0
	  adda    #width,a1
sucheck   btst    #7,status(a3)   a3 setup by savecrtstate
	  beq     sucheck
	  dbra    d1,suloop
	  dbra    d0,suloop2

* Clear bottom line on screen
*
	  movea.l #clearl,a0
	  adda.l  screen(a5),a0
	  move    #15,d0
bclrloop  move.b  (a0),(a1)
	  adda    #width,a1
bcheck    btst    #7,status(a3)
	  beq     bcheck
	  dbra    d0,bclrloop
	  bsr     restcrtstate

	  bra     changecursor

*
*    cscrolldown
*
*    scrolls the screen down one text line
*
cscrolldown bsr     changecursor
	    movea.l screen(a5),a0
	    move    maxy(a5),d0
	    mulu    #16384,d0
	    sub.l   #width,d0
	    adda.l  d0,a0
	    movea.l a0,a1
	    adda    #16384,a0         point to 1 char row past a1
	    move.w  #131,d0
	    moveq   #0,d1
	    bsr     savecrtstate
	    move    maxy(a5),d0
	    subq    #1,d0
sdloop2     moveq   #15,d1
sdloop      move.b  (a1),(a0)
	    suba    #width,a0
	    suba    #width,a1
sdcheck     btst    #7,status(a3)    a3 setup by savecrtstate
	    beq     sdcheck
	    dbra    d1,sdloop
	    dbra    d0,sdloop2

	    movea.l screen(a5),a0
	    moveq   #15,d0
	    movea.l #clearl,a1
	    adda.l  a0,a1

topclear    move.b  (a1),(a0)
	    adda    #width,a0
topcheck    btst    #7,status(a3)    a3 setup by savecrtstate
	    beq     topcheck
	    dbra    d0,topclear
	    bsr     restcrtstate
	    bra     changecursor

*
* cupdatecursor(x,y:shortint);
*

cupdatecursor movea.l cursoraddr(a5),a1
	      movea.l (sp)+,a4     a4 = return addr
	      move    (sp)+,d5     d5 = y
	      move    (sp)+,d3     d3 = x
	      move.w  #138,d0
	      moveq   #-8,d1
	      bsr     savecrtstate
	      move.b  #0,(a1)
	      adda    #width,a1
curscheck     btst    #7,status(a3)  a3 setup in savecrtstate
	      beq     curscheck
	      move.b  #0,(a1)

	      mulu    #16384,d5     16*1024
	      add.l   #14336,d5   spaces you to line 15 of character for cursor
	      lsl     #3,d3
	      movea.l screen(a5),a0
	      adda    d3,a0
	      adda.l  d5,a0
	      move.l  a0,cursoraddr(a5)
curscheck1    btst    #7,status(a3)
	      beq     curscheck1
	      move.b  #0,(a0)
	      adda    #width,a0
curcheck2     btst    #7,status(a3)
	      beq     curcheck2
	      move.b  #0,(a0)
curcheck3     bsr     restcrtstate

	      jmp     (a4)

*
*  cclear(xpos,ypos,nchars:shortint);  REVISED FOR 3.01 9/13/84
*    -- clears nchars starting at xpos, ypos
*    -- nchars + xpos must not exceed 128
*       no range checking is done
*

cclear        bsr     changecursor
	      movea.l (sp)+,a4     a4 = return address
	      move    (sp)+,d4     d4 = number of characters to clear
	      move    (sp)+,d3     d3 = y to begin at
	      mulu    #16384,d3    d3.l = offset to y
	      move    (sp)+,d5     d5 = x
	      move.l  a4,-(sp)     stack return address
	      lsl     #3,d5        d5 = byte offset to begin at
	      movea.l screen(a5),a0
	      movea.l #clearl,a1
	      adda.l  a0,a1        blank line addr in a1
	      adda.l  d3,a0        a0 = where to begin it all
	      adda    d5,a0        after adding x offset

	      move    d4,d3        use requested length
	      lsl     #3,d3        convert to pixels
	      neg     d3           complement
	      move.w  d3,d1
	      move.w  #131,d0
	      bsr     savecrtstate setup control regs

	      moveq   #15,d3       16 pixel rows per character line
clearpart     move.b  (a1),(a0)
	      adda    #width,a0
clearcheck    btst    #7,status(a3)  a3 setup in savecrtstate
	      beq     clearcheck
	      dbra    d3,clearpart
	      bsr     restcrtstate
doneclear     equ     *


changecursor  movea.l cursoraddr(a5),a1
	      move.w  #138,d0
	      moveq   #-8,d1
	      bsr     savecrtstate
	      move.b  #0,(a1)
	      adda.l  #width,a1
curchcheck    btst    #7,status(a3)   a3 setup by savecrtstate
	      beq     curchcheck
	      move.b  #0,(a1)
	      bsr     restcrtstate
	      rts


cshiftleft    moveq   #1,d0        get pointer to last line of screen
	      add     maxy(a5),d0
	      mulu    #16384,d0    16*1024*screenheight in d0
	      movea.l screen(a5),a0
	      adda.l  d0,a0        pointer to last char line now in a0
	      movea.l a0,a1
	      addq    #8,a1        a1 will be source
cshift1       moveq   #-8,d0       get # pixels to move
	      add     maxx(a5),d0
	      lsl     #3,d0        d0 has # pixels in keybuffer
	      neg     d0
	      moveq   #15,d4       counter for row move
	      move    d0,d1   set up width register
	      move    #131,d0 and replacement rule
	      bsr     savecrtstate
cshift3       move.b  (a1),(a0)    and go for it
	      adda    #width,a0    bump addresses
	      adda    #width,a1    to get next pixel row
cshift4       btst    #7,status(a3)    wait for move done
	      beq     cshift4
	      dbra    d4,cshift3   count till 16 rows done
	      bsr   restcrtstate   fix replacement rule reg and return
	      rts

cshiftright   moveq   #1,d0        get pointer to last row
	      add     maxy(a5),d0
	      mulu    #16384,d0
	      movea.l screen(a5),a0
	      adda.l  d0,a0        a0 points to last char row
	      movea.l a0,a1        make a copy
	      addq    #8,a0        dest in a0 -- 1 char to right
	      bra     cshift1      now do same stuff as shift left


*  procedure cexchange(savearea: windowp; ymin, ymax, xmin, width: shortint);

cexchange     movea.l (sp)+,a4     a4 = return addr
	      move    (sp)+,d0     width of window in pixels in d0
	      lsr     #2,d0        d0=window width in long integers
	      subq    #1,d0        setup for later looping
	      move    (sp)+,d3     d3 = x offset in chars
	      lsl     #3,d3        d3 = x offset in pixels
	      move    (sp)+,d5     d5 = ymax
	      move    (sp)+,d1     d1 = ymin
	      movea.l (sp)+,a1     a1 = ptr to save area
	      sub     d1,d5
	      addq    #1,d5        d5 has # of char rows to move
	      lsl     #4,d5        now has # of pixel rows to move
	      subq    #1,d5       setup for outer loop
	      mulu    #16384,d1    d1 = y offset into frame buffer
	      move    d0,d4        save d0 temporarily
	      moveq   #3,d0        setup replacement rule
	      bsr     savecrtstate
	      move    d4,d0        restore d0
	      movea.l screen(a5),a0 a0 points to frame buffer start
	      adda.l  d1,a0         now points to correct row
	      adda    d3,a0         do x offset into row
cexchg2       movea.l a0,a2         make a working copy
	      move    d0,d7         initialize inner loop
cexchg3       move.l  (a2),d6       screen to temp
	      move.l  (a1),(a2)+    save area to screen
	      move.l  d6,(a1)+      temp to save area
	      dbra    d7,cexchg3    inner loop (pixel row move)
	      adda.l  #width,a0     bump row pointer
	      dbra    d5,cexchg2    outer loop (row count)
	      bsr     restcrtstate  restore control regs
	      jmp     (a4)          done


* procedure cscrollwindow( ymin, ymax, xmin, width: shortint);

cscrollwindow bsr     changecursor
	      moveq   #0,d2          set upscroll flag in d2
cscrollwindc  movea.l (sp)+,a4       a4 = return addr
	      move    (sp)+,d0       d0 = width in chars
	      lsl     #3,d0          d0 = width in pixels
	      neg     d0             setup for repl rule reg
	      move    (sp)+,d1       d1 = x offset of window in chars
	      lsl     #3,d1          d1 = x offset in pixels (bytes)
	      move    (sp)+,d5       d5 = ymax
	      move    (sp)+,d3       d3 = ymin
	      sub     d3,d5          d5 has # of rows to move
	      mulu    #16,d5         now d5 has # of pixel rows to move
	      subq    #1,d5          setup for loop
	      movea.l screen(a5),a0  frame buffer addr in a0
	      mulu    #16384,d3      get y offset in bytes
	      adda.l  d3,a0          a0 points to first row of window
	      adda    d1,a0          now add in x offset
	      tst     d2             check up/down flag
	      bne.s   cscrollwindb    and branch if dn
	      movea.l a0,a1          make a copy for source pointer
	      adda.l  #16384,a1      which starts 1 char row down
	      move    d0,d1
	      move    #131,d0   set up control regs
	      bsr     savecrtstate

cscrollwin1   move.b  (a1),(a0)      move a row
	      adda    #width,a0
	      adda    #width,a1
cscrollwin2   btst    #7,status(a3)    a3 setup by savecrtstate
	      beq     cscrollwin2
	      dbra    d5,cscrollwin1  loop till all rows moved
cscrollw2b    moveq   #15,d5          clear first or last line of window
	      movea.l #clearl,a1
	      adda.l  screen(a5),a1

cscrollwin3   move.b  (a1),(a0)       clear a pixel row
	      adda    #width,a0
cscrollwin4   btst    #7,status(a3)       wait for bitmover
	      beq     cscrollwin4
	      dbra    d5,cscrollwin3  do 16 rows
	      bsr     restcrtstate
	      move.l  a4,-(sp)        restack return addr
	      bra     changecursor    and fixup cursor

cscrollwindb  moveq   #0,d4           calculate first source row loc.
	      move    d5,d4
	      addq    #1,d4           d4 = #pixel rows to move
	      moveq   #10,d2
	      lsl.l   d2,d4           mpy by 1024 to get offset in FB
	      adda.l  d4,a0           add to prev. calculated pointer
	      suba    #width,a0       point to bottom row to move
	      movea.l a0,a1           a1 is source pointer
	      adda    #16384,a0       a0 points to destination
	      move    d0,d1           d1 has width for window reg
	      move    #131,d0         setup repl rule value
	      bsr     savecrtstate
cscrollwin5   move.b  (a1),(a0)       move a pixel row
	      suba    #width,a0       point to next src and dst
	      suba    #width,a1
cscrollwin6   btst    #7,status(a3)   wait till bit mover done
	      beq     cscrollwin6
	      dbra    d5,cscrollwin5  go till all rows moved
	      movea.l a1,a0
	      adda    #width,a0       a0 points to char row to clear
	      bra     cscrollw2b

cscrollwinddn bsr     changecursor
	      moveq   #1,d2          set down scroll flag
	      bra     cscrollwindc    go to common code


cdbscrolll    bsr     changecursor
	      moveq   #0,d2          set left scroll flag
cdbscrollb    movea.l (sp)+,a4       pickup return addr
	      move    (sp)+,d1       width in chars
	      subq    #1,d1          actual width to move is 1 less
	      lsl     #3,d1          width in pixels in d1
	      neg     d1             setup for window width reg
	      move    (sp)+,d0       x offset in chars
	      lsl     #3,d0          d0 = x offset in pixels
	      move    (sp)+,d5       d5 = ymax
	      moveq   #0,d3
	      move    (sp)+,d3       d3 = ymin
	      sub     d3,d5
	      addq    #1,d5          d5 = # char rows to move
	      lsl     #4,d5          d5 = # pixel rows to move
	      subq    #1,d5          setup d5 for loop
	      movea.l screen(a5),a0
	      moveq   #14,d4
	      lsl.l   d4,d3          d3 = d3*16384 ( y window start offset)
	      adda.l  d3,a0
	      adda    d0,a0          add in x offset
	      movea.l a0,a1          copy to a1
	      tst     d2             check left/right flag
	      bne.s   cdbscroll2     if right, skip
	      adda    #8,a0          else src is to right of dest
	      bra.s   cdbscroll3
cdbscroll2    adda    #8,a1          if right then src is left of dest
cdbscroll3    move    #131,d0        setup replacement rule
	      bsr     savecrtstate
cdbscroll4    move.b  (a0),(a1)      move a pixel row
	      adda    #width,a0       point to next row
	      adda    #width,a1
cdbscroll5    btst    #7,status(a3)  check status
	      beq     cdbscroll5
	      dbra    d5,cdbscroll4  loop till all rows moved
	      bsr     restcrtstate
	      move.l  a4,-(sp)
	      bra     changecursor   finished!

cdbscrollr    bsr     changecursor
	      moveq   #1,d2          set right shift flag
	      bra     cdbscrollb     go to common code

*   procedure cdbhighl(ord(char),x,y:shortint);
*
*   Assumes the character is in the highlight range
*   Does not know about current highlight state of character
*
cdbhighl movea.l (sp)+,a4
	 move    (sp)+,d0  d0 = y
	 mulu    #16384,d0
	 movea.l d0,a0
	 adda.l  screen(a5),a0
	 move    (sp)+,d5  d5 = x (this will be used later also)
	 lsl     #3,d5
	 adda    d5,a0     a0 = address of byte to begin at
	 move    (sp)+,d2     d2 = highlight char
	 bsr     changecursor   take off the cursor
	 move    #138,d0        repl rule = negate
	 moveq   #-8,d1         we will work with 8 byte wide chars
	 bsr     savecrtstate
	 btst    #0,d2          invert?
	 beq.s   cdbhigh3       no, try for underline
	 moveq   #15,d3         setup loop for invert char
	 movea.l a0,a1          copy pointer to the char
cdbhigh1 move.b  #0,(a1)      do a row  RQ
	 adda    #width,a1      point to next row
cdbhigh2 btst    #7,status(a3)  is move done?
	 beq     cdbhigh2       wait here till done
	 dbra    d3,cdbhigh1    loop till 16 rows done
cdbhigh3 btst    #2,d2          underline?
	 beq.s   cdbhigh5       no -- drop out
	 adda    #15360,a0      point a0 to last row of char
	 move.b  #0,(a0)        and negate it
cdbhigh4 btst    #7,status(a3)  wait for done
	 beq     cdbhigh4
cdbhigh5 bsr     restcrtstate
	 move.l  a4,-(sp)
	 bra     changecursor   put the cursor back

	      end
@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 621
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 621
	     page
*
*   GATOR bit-mapped alpha driver
*
*     Pascal 3.0 version by J. Schmidt
*
	 def     cscrollup,cscrolldown,cupdatecursor,cchar,cclear
	 def     cbuildtable,cshiftleft,cshiftright
	 def     cexchange,cscrollwindow,changecursor
	 def     cscrollwinddn,cdbscrolll,cdbscrollr,cdbhighl
	 rorg.l 0
	 refa    crtb,sysdevs
	 nosyms

clearl   equ     $CC000     blank pixel row offset

maxx     equ     crtb-10
maxy     equ     crtb-12
cursoraddr equ    crtb-4
highlight equ    crtb-18
controladdr equ  sysdevs-86
screen   equ     sysdevs-90
replcopy equ     sysdevs-92
windcopy equ     sysdevs-94

replreg  equ     $4008
windreg  equ     $400c
status   equ     $4001

width        equ     1024
initoffset   equ      $23                   offset to initialization offset
fontoffset   equ      $3B                   offset to font info offset

*   gbuildtable(ptr);

cbuildtable movea.l (sp)+,a4  a4 = return address
	    movea.l  controladdr(a5),a0    get pointer to ROM start
	    moveq    #0,d0
	    moveq    #0,d1
	    move.b   status(a0),d0           get status reg again
	    lsr.b    #2,d0                  get monitor type bits
	    and.b    #12,d0
	    move.b   initoffset(a0,d0.w),d1  get MSB of info addr offset
	    lsl.w    #8,d1
	    move.b   initoffset+2(a0,d0.w),d1  get LSB of info addr offset
	    movea.l  a0,a1                  make copy of ROM start addr
	    adda     d1,a1                  a1 points to init info now
ginitblock  moveq    #0,d1                  clear some regs
	    moveq    #0,d0
	    move.b   2(a1),d0               get word count to initialize
	    movep    4(a1),d1               form destination offset
	    add.l    a0,d1                  d1 points to dest addr
	    lea      8(a1),a2               a2 points to first data byte
	    movea.l  d1,a3                  a3 points to destination
ginitloop   movep    0(a2),d1                form a data word in d1
	    move.w   d1,(a3)+               move data to the destination addr
	    btst     #6,(a1)                increment data pointer
	    bne.s    ginit1                 based on control byte
	    addq     #4,a2
ginit1      dbra     d0,ginitloop           loop till word count exhausted
	    btst     #7,(a1)                was this last block?
	    bne.s    ginitdone              yes -- go return
	    btst     #6,(a1)                adjust data pointer
	    beq.s    ginit2                 to point to next init block
	    addq     #4,a2
ginit2      movea.l  a2,a1                  a1 points to new init block
	    bra      ginitblock             do the initialize
ginitdone   move.w  #128,replreg(a0)  set repl rule to clear
	    move.w  #0,windreg(a0)
	    moveq   #0,d0
	    move.b  status(a0),d0
	    and     #15,d0               get frame buffer location
	    moveq   #20,d1
	    lsl.l   d1,d0               put it in right place
	    move.l  d0,screen(a5)
	    movea.l d0,a1               clear the whole frame buffer
	    move    #1019,d0              except last 4 pixel lines
zloop       move.b  #00,(a1)
	    adda.l  #width,a1
zcheck      btst    #7,status(a0)
	    beq     zcheck
	    dbra    d0,zloop
	    move    #3,replreg(a0)
	    move    #3,replcopy(a5)
	    clr     windcopy(a5)
	    movep   fontoffset(a0),d1     get font info offset
	    lea     2(a0,d1.w),a1         point to font id code
	    moveq   #2,d7                 count number of font found with d7
fontidchk   movep   2(a1),d2              get offset of font info
	    lea     10(a0,d2.w),a3        a3 points to first char of font
	    cmpi.b  #1,(a1)               is font = roman8 ?
	    beq.s   unpkroman             if so go unpack it
	    cmpi.b  #2,(a1)               is font = kana8 upper half?
	    beq.s   unpkkana              if so go unpack it
nextfont    addq    #6,a1                 point to next font id
	    tst     d7                    have we found both fonts?
	    bne     fontidchk             if not look at this one
	    move.l  screen(a5),cursoraddr(a5)  initialize cursor location
	    bsr     changecursor          turn it on
	    jmp     (a4)                  return

unpkroman   move    #256,d3               #chars to unpack
	    movea.l #$C0000,a2            start at beginning of font storage
unpackit    adda.l  screen(a5),a2
	    subq    #1,d7                 count a found font
	    lsl     #4,d3                 get number of pixel rows to unpack
	    subq    #1,d3
unpackrow   moveq   #7,d4                 we need to look at 8 bits/byte
unpackrow2  btst    d4,(a3)               is bit set in font?
	    sne     (a2)+                 set frame buffer byte accordingly
	    dbra    d4,unpackrow2         loop till all 8 bits done
	    addq    #2,a3                 look at next font byte
	    dbra    d3,unpackrow          and loop till all font rows done
	    bra     nextfont              go look at next font
unpkkana    move    #128,d3               kana8 upper half has 128 chars
	    movea.l #$C8000,a2            store at font storage + 256*128
	    bra     unpackit



* savecrtstate: preserve bit mover  state
*               Entry: d0= replacement rule
*                      d1= window width
*
*               Uses:  a2,a3
*
savecrtstate equ *
	    movea.l controladdr(a5),a3
savestate1  btst   #7,status(a3)    wait for not busy
	    beq    savestate1
	    movea.l (sp)+,a2      save ret addr
	    move   replcopy(a5),-(sp)   save old copy
	    move   windcopy(a5),-(sp)
	    move   d0,replcopy(a5)      setup new values
	    move   d1,windcopy(a5)
	    move   d0,replreg(a3)           setup the registers
	    move   d1,windreg(a3)

	    jmp    (a2)
*
* restcrtstate: restores window width and replacement rule regs
*
*           Uses:  a3
*
restcrtstate equ *
	    movea.l controladdr(a5),a3
restcrt1    btst   #7,status(a3)      wait for not busy
	    beq    restcrt1
	    move   4(sp),windcopy(a5)  restore copy variables
	    move   6(sp),replcopy(a5)
	    move   windcopy(a5),windreg(a3)  restore the registers
	    move   replcopy(a5),replreg(a3)
	    move.l (sp)+,(sp)            move up return addr
	    rts                          and return

*   procedure cchar(ord(char),x,y:shortint);

cchar    movea.l (sp)+,a4
	 move    (sp)+,d0  d0 = y
	 mulu    #16384,d0
	 movea.l d0,a0
	 adda.l  screen(a5),a0
	 move    (sp)+,d5  d5 = x (this will be used later also)
	 lsl     #3,d5
	 adda    d5,a0     a0 = address of byte to begin at
	 movea.l screen(a5),a1    setup font addr in a1
	 adda.l  #$C0000,a1       fonts are just past visible space
	 move    (sp)+,d0  d0 = character
	 mulu    #128,d0
	 lea     0(a1,d0.l),a1  a1 = address of char in font storage
	 move    #width-8,d7
	 move    #3,d0       set repl rule to replace
	 btst    #0,highlight(a5)   inverse video?
	 beq.s   ccharb             if not, skip next instruction
	 move    #12,d0             else set repl rule to invert
ccharb   moveq   #0,d1
	 bsr     savecrtstate
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 adda    d7,a0
	 move.l  (a1)+,(a0)+
	 move.l  (a1)+,(a0)+
	 btst    #2,highlight(a5)     underline?
	 beq.s   cchar1               no, skip next part
	 bsr     restcrtstate
	 move    #138,d0              setup to invert line 16
	 moveq   #-8,d1
	 bsr     savecrtstate
	 adda    #-8,a0               a0 points to line 16
	 move.b  #0,(a0)              do the invert
cchar1   bsr     restcrtstate
	 jmp     (a4)
*
*
*   cscrollup;
*
*   scrolls the screen up one line of alpha text (16 graphics lines)
*
cscrollup bsr     changecursor
	  movea.l screen(a5),a0
	  movea.l a0,a1
	  adda    #16384,a0
	  move.w  #131,d0
	  moveq   #0,d1
	  bsr     savecrtstate
	  move    maxy(a5),d0
	  subq    #1,d0
suloop2   moveq   #15,d1
suloop    move.b  (a0),(a1)
	  adda    #width,a0
	  adda    #width,a1
sucheck   btst    #7,status(a3)   a3 setup by savecrtstate
	  beq     sucheck
	  dbra    d1,suloop
	  dbra    d0,suloop2

* Clear bottom line on screen
*
	  movea.l #clearl,a0
	  adda.l  screen(a5),a0
	  move    #15,d0
bclrloop  move.b  (a0),(a1)
	  adda    #width,a1
bcheck    btst    #7,status(a3)
	  beq     bcheck
	  dbra    d0,bclrloop
	  bsr     restcrtstate

	  bra     changecursor

*
*    cscrolldown
*
*    scrolls the screen down one text line
*
cscrolldown bsr     changecursor
	    movea.l screen(a5),a0
	    move    maxy(a5),d0
	    mulu    #16384,d0
	    sub.l   #width,d0
	    adda.l  d0,a0
	    movea.l a0,a1
	    adda    #16384,a0         point to 1 char row past a1
	    move.w  #131,d0
	    moveq   #0,d1
	    bsr     savecrtstate
	    move    maxy(a5),d0
	    subq    #1,d0
sdloop2     moveq   #15,d1
sdloop      move.b  (a1),(a0)
	    suba    #width,a0
	    suba    #width,a1
sdcheck     btst    #7,status(a3)    a3 setup by savecrtstate
	    beq     sdcheck
	    dbra    d1,sdloop
	    dbra    d0,sdloop2

	    movea.l screen(a5),a0
	    moveq   #15,d0
	    movea.l #clearl,a1
	    adda.l  a0,a1

topclear    move.b  (a1),(a0)
	    adda    #width,a0
topcheck    btst    #7,status(a3)    a3 setup by savecrtstate
	    beq     topcheck
	    dbra    d0,topclear
	    bsr     restcrtstate
	    bra     changecursor

*
* cupdatecursor(x,y:shortint);
*

cupdatecursor movea.l cursoraddr(a5),a1
	      movea.l (sp)+,a4     a4 = return addr
	      move    (sp)+,d5     d5 = y
	      move    (sp)+,d3     d3 = x
	      move.w  #138,d0
	      moveq   #-8,d1
	      bsr     savecrtstate
	      move.b  #0,(a1)
	      adda    #width,a1
curscheck     btst    #7,status(a3)  a3 setup in savecrtstate
	      beq     curscheck
	      move.b  #0,(a1)

	      mulu    #16384,d5     16*1024
	      add.l   #14336,d5   spaces you to line 15 of character for cursor
	      lsl     #3,d3
	      movea.l screen(a5),a0
	      adda    d3,a0
	      adda.l  d5,a0
	      move.l  a0,cursoraddr(a5)
curscheck1    btst    #7,status(a3)
	      beq     curscheck1
	      move.b  #0,(a0)
	      adda    #width,a0
curcheck2     btst    #7,status(a3)
	      beq     curcheck2
	      move.b  #0,(a0)
curcheck3     bsr     restcrtstate

	      jmp     (a4)

*
*  cclear(xpos,ypos,nchars:shortint);  REVISED FOR 3.01 9/13/84
*    -- clears nchars starting at xpos, ypos
*    -- nchars + xpos must not exceed 128
*       no range checking is done
*

cclear        bsr     changecursor
	      movea.l (sp)+,a4     a4 = return address
	      move    (sp)+,d4     d4 = number of characters to clear
	      move    (sp)+,d3     d3 = y to begin at
	      mulu    #16384,d3    d3.l = offset to y
	      move    (sp)+,d5     d5 = x
	      move.l  a4,-(sp)     stack return address
	      lsl     #3,d5        d5 = byte offset to begin at
	      movea.l screen(a5),a0
	      movea.l #clearl,a1
	      adda.l  a0,a1        blank line addr in a1
	      adda.l  d3,a0        a0 = where to begin it all
	      adda    d5,a0        after adding x offset

	      move    d4,d3        use requested length
	      lsl     #3,d3        convert to pixels
	      neg     d3           complement
	      move.w  d3,d1
	      move.w  #131,d0
	      bsr     savecrtstate setup control regs

	      moveq   #15,d3       16 pixel rows per character line
clearpart     move.b  (a1),(a0)
	      adda    #width,a0
clearcheck    btst    #7,status(a3)  a3 setup in savecrtstate
	      beq     clearcheck
	      dbra    d3,clearpart
	      bsr     restcrtstate
doneclear     equ     *


changecursor  movea.l cursoraddr(a5),a1
	      move.w  #138,d0
	      moveq   #-8,d1
	      bsr     savecrtstate
	      move.b  #0,(a1)
	      adda.l  #width,a1
curchcheck    btst    #7,status(a3)   a3 setup by savecrtstate
	      beq     curchcheck
	      move.b  #0,(a1)
	      bsr     restcrtstate
	      rts


cshiftleft    moveq   #1,d0        get pointer to last line of screen
	      add     maxy(a5),d0
	      mulu    #16384,d0    16*1024*screenheight in d0
	      movea.l screen(a5),a0
	      adda.l  d0,a0        pointer to last char line now in a0
	      movea.l a0,a1
	      addq    #8,a1        a1 will be source
cshift1       moveq   #-8,d0       get # pixels to move
	      add     maxx(a5),d0
	      lsl     #3,d0        d0 has # pixels in keybuffer
	      neg     d0
	      moveq   #15,d4       counter for row move
	      move    d0,d1   set up width register
	      move    #131,d0 and replacement rule
	      bsr     savecrtstate
cshift3       move.b  (a1),(a0)    and go for it
	      adda    #width,a0    bump addresses
	      adda    #width,a1    to get next pixel row
cshift4       btst    #7,status(a3)    wait for move done
	      beq     cshift4
	      dbra    d4,cshift3   count till 16 rows done
	      bsr   restcrtstate   fix replacement rule reg and return
	      rts

cshiftright   moveq   #1,d0        get pointer to last row
	      add     maxy(a5),d0
	      mulu    #16384,d0
	      movea.l screen(a5),a0
	      adda.l  d0,a0        a0 points to last char row
	      movea.l a0,a1        make a copy
	      addq    #8,a0        dest in a0 -- 1 char to right
	      bra     cshift1      now do same stuff as shift left


*  procedure cexchange(savearea: windowp; ymin, ymax, xmin, width: shortint);

cexchange     movea.l (sp)+,a4     a4 = return addr
	      move    (sp)+,d0     width of window in pixels in d0
	      lsr     #2,d0        d0=window width in long integers
	      subq    #1,d0        setup for later looping
	      move    (sp)+,d3     d3 = x offset in chars
	      lsl     #3,d3        d3 = x offset in pixels
	      move    (sp)+,d5     d5 = ymax
	      move    (sp)+,d1     d1 = ymin
	      movea.l (sp)+,a1     a1 = ptr to save area
	      sub     d1,d5
	      addq    #1,d5        d5 has # of char rows to move
	      lsl     #4,d5        now has # of pixel rows to move
	      subq    #1,d5       setup for outer loop
	      mulu    #16384,d1    d1 = y offset into frame buffer
	      move    d0,d4        save d0 temporarily
	      moveq   #3,d0        setup replacement rule
	      bsr     savecrtstate
	      move    d4,d0        restore d0
	      movea.l screen(a5),a0 a0 points to frame buffer start
	      adda.l  d1,a0         now points to correct row
	      adda    d3,a0         do x offset into row
cexchg2       movea.l a0,a2         make a working copy
	      move    d0,d7         initialize inner loop
cexchg3       move.l  (a2),d6       screen to temp
	      move.l  (a1),(a2)+    save area to screen
	      move.l  d6,(a1)+      temp to save area
	      dbra    d7,cexchg3    inner loop (pixel row move)
	      adda.l  #width,a0     bump row pointer
	      dbra    d5,cexchg2    outer loop (row count)
	      bsr     restcrtstate  restore control regs
	      jmp     (a4)          done


* procedure cscrollwindow( ymin, ymax, xmin, width: shortint);

cscrollwindow bsr     changecursor
	      moveq   #0,d2          set upscroll flag in d2
cscrollwindc  movea.l (sp)+,a4       a4 = return addr
	      move    (sp)+,d0       d0 = width in chars
	      lsl     #3,d0          d0 = width in pixels
	      neg     d0             setup for repl rule reg
	      move    (sp)+,d1       d1 = x offset of window in chars
	      lsl     #3,d1          d1 = x offset in pixels (bytes)
	      move    (sp)+,d5       d5 = ymax
	      move    (sp)+,d3       d3 = ymin
	      sub     d3,d5          d5 has # of rows to move
	      mulu    #16,d5         now d5 has # of pixel rows to move
	      subq    #1,d5          setup for loop
	      movea.l screen(a5),a0  frame buffer addr in a0
	      mulu    #16384,d3      get y offset in bytes
	      adda.l  d3,a0          a0 points to first row of window
	      adda    d1,a0          now add in x offset
	      tst     d2             check up/down flag
	      bne.s   cscrollwindb    and branch if dn
	      movea.l a0,a1          make a copy for source pointer
	      adda.l  #16384,a1      which starts 1 char row down
	      move    d0,d1
	      move    #131,d0   set up control regs
	      bsr     savecrtstate

cscrollwin1   move.b  (a1),(a0)      move a row
	      adda    #width,a0
	      adda    #width,a1
cscrollwin2   btst    #7,status(a3)    a3 setup by savecrtstate
	      beq     cscrollwin2
	      dbra    d5,cscrollwin1  loop till all rows moved
cscrollw2b    moveq   #15,d5          clear first or last line of window
	      movea.l #clearl,a1
	      adda.l  screen(a5),a1

cscrollwin3   move.b  (a1),(a0)       clear a pixel row
	      adda    #width,a0
cscrollwin4   btst    #7,status(a3)       wait for bitmover
	      beq     cscrollwin4
	      dbra    d5,cscrollwin3  do 16 rows
	      bsr     restcrtstate
	      move.l  a4,-(sp)        restack return addr
	      bra     changecursor    and fixup cursor

cscrollwindb  moveq   #0,d4           calculate first source row loc.
	      move    d5,d4
	      addq    #1,d4           d4 = #pixel rows to move
	      moveq   #10,d2
	      lsl.l   d2,d4           mpy by 1024 to get offset in FB
	      adda.l  d4,a0           add to prev. calculated pointer
	      suba    #width,a0       point to bottom row to move
	      movea.l a0,a1           a1 is source pointer
	      adda    #16384,a0       a0 points to destination
	      move    d0,d1           d1 has width for window reg
	      move    #131,d0         setup repl rule value
	      bsr     savecrtstate
cscrollwin5   move.b  (a1),(a0)       move a pixel row
	      suba    #width,a0       point to next src and dst
	      suba    #width,a1
cscrollwin6   btst    #7,status(a3)   wait till bit mover done
	      beq     cscrollwin6
	      dbra    d5,cscrollwin5  go till all rows moved
	      movea.l a1,a0
	      adda    #width,a0       a0 points to char row to clear
	      bra     cscrollw2b

cscrollwinddn bsr     changecursor
	      moveq   #1,d2          set down scroll flag
	      bra     cscrollwindc    go to common code


cdbscrolll    bsr     changecursor
	      moveq   #0,d2          set left scroll flag
cdbscrollb    movea.l (sp)+,a4       pickup return addr
	      move    (sp)+,d1       width in chars
	      subq    #1,d1          actual width to move is 1 less
	      lsl     #3,d1          width in pixels in d1
	      neg     d1             setup for window width reg
	      move    (sp)+,d0       x offset in chars
	      lsl     #3,d0          d0 = x offset in pixels
	      move    (sp)+,d5       d5 = ymax
	      moveq   #0,d3
	      move    (sp)+,d3       d3 = ymin
	      sub     d3,d5
	      addq    #1,d5          d5 = # char rows to move
	      lsl     #4,d5          d5 = # pixel rows to move
	      subq    #1,d5          setup d5 for loop
	      movea.l screen(a5),a0
	      moveq   #14,d4
	      lsl.l   d4,d3          d3 = d3*16384 ( y window start offset)
	      adda.l  d3,a0
	      adda    d0,a0          add in x offset
	      movea.l a0,a1          copy to a1
	      tst     d2             check left/right flag
	      bne.s   cdbscroll2     if right, skip
	      adda    #8,a0          else src is to right of dest
	      bra.s   cdbscroll3
cdbscroll2    adda    #8,a1          if right then src is left of dest
cdbscroll3    move    #131,d0        setup replacement rule
	      bsr     savecrtstate
cdbscroll4    move.b  (a0),(a1)      move a pixel row
	      adda    #width,a0       point to next row
	      adda    #width,a1
cdbscroll5    btst    #7,status(a3)  check status
	      beq     cdbscroll5
	      dbra    d5,cdbscroll4  loop till all rows moved
	      bsr     restcrtstate
	      move.l  a4,-(sp)
	      bra     changecursor   finished!

cdbscrollr    bsr     changecursor
	      moveq   #1,d2          set right shift flag
	      bra     cdbscrollb     go to common code

*   procedure cdbhighl(ord(char),x,y:shortint);
*
*   Assumes the character is in the highlight range
*   Does not know about current highlight state of character
*
cdbhighl movea.l (sp)+,a4
	 move    (sp)+,d0  d0 = y
	 mulu    #16384,d0
	 movea.l d0,a0
	 adda.l  screen(a5),a0
	 move    (sp)+,d5  d5 = x (this will be used later also)
	 lsl     #3,d5
	 adda    d5,a0     a0 = address of byte to begin at
	 move    (sp)+,d2     d2 = highlight char
	 bsr     changecursor   take off the cursor
	 move    #138,d0        repl rule = negate
	 moveq   #-8,d1         we will work with 8 byte wide chars
	 bsr     savecrtstate
	 btst    #0,d2          invert?
	 beq.s   cdbhigh3       no, try for underline
	 moveq   #15,d3         setup loop for invert char
	 movea.l a0,a1          copy pointer to the char
cdbhigh1 move.b  #0,(a1)      do a row  RQ
	 adda    #width,a1      point to next row
cdbhigh2 btst    #7,status(a3)  is move done?
	 beq     cdbhigh2       wait here till done
	 dbra    d3,cdbhigh1    loop till 16 rows done
cdbhigh3 btst    #2,d2          underline?
	 beq.s   cdbhigh5       no -- drop out
	 adda    #15360,a0      point a0 to last row of char
	 move.b  #0,(a0)        and negate it
cdbhigh4 btst    #7,status(a3)  wait for done
	 beq     cdbhigh4
cdbhigh5 bsr     restcrtstate
	 move.l  a4,-(sp)
	 bra     changecursor   put the cursor back

	      end
@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
