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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

6.1
date     86.11.04.17.51.59;  author paws;  state Exp;
branches ;
next     5.2;

5.2
date     86.10.29.15.26.21;  author geli;  state Exp;
branches ;
next     5.1;

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

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

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

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

1.1
date     86.06.30.14.46.12;  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
*
*   GATORBOX bit-mapped alpha driver
*
*     Pascal 3.1 version by J. Schmidt
*
	 def     cscrollup,cscrolldown,cupdatecursor,cchar,cclear
	 def     cbuildtable,cshiftleft,cshiftright
	 def     cexchange,cscrollwindow,cursoron,cursoroff
	 def     cscrollwinddn,cdbscrolll,cdbscrollr
	 rorg.l 0
	 refa    crtgb,sysdevs
	 nosyms

clearl   equ     $CC000     blank pixel row offset

maxx        equ  crtgb-10
maxy        equ  crtgb-12
cursoraddr  equ  crtgb-4
highlight   equ  crtgb-18
cursorhold  equ  crtgb-34    content of current cursor location
controladdr equ  sysdevs-86
screen      equ  sysdevs-90
writecopy   equ  sysdevs-96


replreg  equ     $5006
widthreg equ     $5000
htreg    equ     $5002
writereg  equ    $6008      write protect reg
status   equ     $0002      secondary interrup reg has blockmover status
blinkrega equ    $6001      blink/enable reg A
blinkregb equ    $6005      blink/enable reg B


cmapbusy equ     $6803      color map busy
cmapptr  equ     $68B8      color map ptr reg  (word)
cmapred  equ     $69B2      color map red (word)
cmapgrn  equ     $69B4      color map green (word)
cmapblu  equ     $69B6      color map blue  (word)
cmapwrt  equ     $68F0      color map write trigger (word)



width        equ     1024
initoffset   equ      $23            offset to initialization offset
fontoffset   equ      $3B            offset to font info offset
frameoffset  equ      $5D            offset to frame buffer reg. offset
cmapidoff    equ      $57            offset to color map id offset
cmapinitoff  equ      $3F            offset to cmap 0 init region offset
framecnt     equ      $5B            offset of number of frames
*
*   cbuildtablei
*
cbuildtable movea.l  controladdr(a5),a0    get pointer to ROM start
	    movep    initoffset(a0),d1     form pointer to init block
	    movea.l  a0,a1                  make copy of ROM start addr
	    adda     d1,a1                  a1 points to init info now
	    jsr      ginitblock             call the initializatiion routine
	    moveq    #0,d1
	    movep    cmapidoff(a0),d0       get ptr to color map id reg
	    tst      d0                     if ptr=0, then use init region 0
	    beq.s    cinitclr
	    move.b   0(a0,d0),d1            get cmap id into d1
cinitclr    and      #3,d1                  look at least sig bits
	    lsl      #2,d1
	    move.b   cmapinitoff(a0,d1.w),d2  form cmap init block addr
	    lsl      #8,d2
	    move.b   cmapinitoff+2(a0,d1.w),d2
	    movea.l  a0,a1
	    adda     d2,a1                  a1 points to cmap init block
	    jsr      ginitblock
	    clr.l    screen(a5)             clear space for frame buffer addr
	    movep.w  frameoffset(a0),d0     get offset of frame buffer loc.
	    move.b   0(a0,d0),screen+1(a5)  form frame buffer addr
	    clr      writereg(a0)           enable all planes for write
	    clr      writecopy(a5)
	    moveq    #0,d0                  setup blink enable regs
	    moveq    #0,d1
	    move.b   framecnt(a0),d0        get number of frames
	    beq.s    creadfb                if zero we can use fb to find out
	    move     #$FFFF,d1              d1 will hold bit mask
	    moveq    #16,d2
	    sub      d0,d2                  d2 = shift count for d1
	    lsr      d2,d1                  d1 = blink/enable mask
	    bra.s    cinitblink
creadfb     movea.l  screen(a5),a1         use fb to get mask
	    move.b   #-1,(a1)
	    move.b   (a1),d1
cinitblink  move.b   d1,blinkrega(a0)      setup blink/enable regs
	    move.b   d1,blinkregb(a0)
	    movea.l  screen(a5),a1
	    move.w  #128+64,replreg(a0)  set repl rule to clear,down/rt
	    move.w  #0,widthreg(a0)
	    move.w  #1,htreg(a0)         clear all but last 4 pixel lines
	    move.b  #00,(a1)             clear the whole frame buffer
zcheck      btst    #4,status(a0)
	    bne     zcheck
	    move    #3,replreg(a0)

	    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 ?
	    bne.s   notroman
	    bsr     unpkroman             if so go unpack it
notroman    cmpi.b  #2,(a1)               is font = kana8 upper half?
	    bne.s   nextfont
	    bsr.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

	    lea     cmaptable,a1          initialize the color map
	    moveq   #0,d1                 clear some registers
	    move.l  d1,d2
	    move.l  d1,d3
	    move.l  d1,d4
cmaploop1   move.b  (a1)+,d2              get rgb values in d2-d4
	    move.b  (a1)+,d3
	    move.b  (a1)+,d4
	    bsr     cmapenter             stuff the color map entry
	    addq    #1,d1                 bump cmap pointer value
	    cmp     #16,d1                have we done 16 yet?
	    bne     cmaploop1             if not then continue
	    moveq   #-1,d2                set entries 16-255 to white
	    move.l  d2,d3
	    move.l  d2,d4
cmaploop2   bsr     cmapenter
	    addq    #1,d1
	    cmp     #256,d1                done with cmap init?
	    bne     cmaploop2

cmaploop3   btst     #2,cmapbusy(a0)        wait for color map not busy
	    bne      cmaploop3
	    moveq    #0,d1                  CHECK FOR NEREID COLOR MAP 6/85
	    movep    cmapidoff(a0),d0       get ptr to color map id reg
	    tst      d0                     if ptr=0, then use init region 0
	    beq.s    cinitclr2
	    move.b   0(a0,d0),d1            get cmap id into d1
cinitclr2   and      #3,d1                  look at least sig bits
	    bne.s    notnereid              if result<>0 then skip
	    moveq    #0,d0                  else set rgb regs to 0
	    move     d0,cmapred(a0)
	    move     0,d7                   delay for nereid SFB
	    move     d0,cmapgrn(a0)
	    move     0,d7                   delay for nereid SFB
	    move     d0,cmapblu(a0)

notnereid   move.l  screen(a5),cursoraddr(a5)  initialize cursor location
	    bsr     cursoron              turn it on
	    rts
*
*   misc utilities for initialization
*
*
unpkkana    moveq   #127,d3               kana8 upper half has 128 chars
	    movea.l #$C8000,a2            store at font storage + 256*128
	    subq    #1,d7                 count a found font
	    bra     unpackit

unpkroman   moveq   #127,d3               #chars to unpack-1
	    subq    #1,d7                 count a found font
	    movea.l #$C0000,a2            start at beginning of font storage
	    bsr.s   unpackit
	    moveq   #127,d3               now unpack second half of font
	    movea.l #$C4000,a2

unpackit    adda.l  screen(a5),a2
	    movea.l a2,a4                 a4 points to font char start addr
	    subq    #8,a4
unpackchar  moveq   #15,d5                unpack 16 rows/char
	    addq    #8,a4                 point to char storage start
	    movea.l a4,a2                 make the working copy
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
	    adda    #width-8,a2           adjust storage pointer
	    dbra    d5,unpackrow          and loop till rows in char done
	    dbra    d3,unpackchar         loop till all chars done
	    rts                           go look at next font

cmapenter   nop
	    btst    #2,cmapbusy(a0)       check for color map busy
	    bne     cmapenter             loop till bit is clear
	    move    0,d7                  delay for nereid SFB
	    move    d1,cmapptr(a0)        set pointer register
	    move    0,d7                  delay for nereid SFB
	    move.w  d2,cmapred(a0)        stuff the rgb regs
	    move    0,d7                  delay for nereid SFB
	    move.w  d3,cmapgrn(a0)
	    move    0,d7                  delay for nereid SFB
	    move.w  d4,cmapblu(a0)
	    move    0,d7                  delay for nereid SFB
	    move    d1,cmapwrt(a0)        hit the write trigger
*           nop                           removed SFB
	    rts                           done with cmap entry write


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
	    btst     #0,(a1)                is this a bit test block?
	    bne.s    ginitbtst              if so go handle it
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
ginit3      addq     #4,a2
ginit2      movea.l  a2,a1                  a1 points to new init block
	    bra      ginitblock             do the initialize
ginitdone   rts

ginitbtst   moveq    #0,d2                  handle bit test blocks here
	    move.b   2(a2),d2               d2 = bit # to test
ginittst2   move     (a3),d3                d3 = data word to test
	    btst     #0,(a2)                check for sense of test
	    bne.s    ginittst3              comp if waiting for 0
	    not      d3
ginittst3   btst     d2,d3                  check the bit
	    beq      ginittst2              if not 1 then loop
	    btst     #7,(a1)                was this last block?
	    bne      ginitdone              if so then return
	    bra      ginit3                 else do next block
*
*
cmaptable   equ      *                      initial color map contents (r,g,b)
	    dc.b     0,0,0                  0
	    dc.b     255,255,255            1
	    dc.b     255,0,0                2
	    dc.b     255,255,0              3
	    dc.b     0,255,0                4
	    dc.b     0,255,255              5
	    dc.b     0,0,255                6
	    dc.b     255,0,255              7
	    dc.b     0,0,0                  8
	    dc.b     204,187,51             9
	    dc.b     51,170,119             10
	    dc.b     136,102,170            11
	    dc.b     204,68,102             12
	    dc.b     255,102,51             13
	    dc.b     255,119,0              14
	    dc.b     221,136,68             15
*
*
* savecrtstate: preserve tile mover  state
*               Entry: d0= replacement rule
*                      d1= window width in tiles
*                      d2= window height in tiles
*                      d3= write protect
*               Uses:  a2,a3
*
savecrtstate equ *
	    movea.l controladdr(a5),a3
savestate1  btst   #4,status(a3)    wait for not busy
	    bne    savestate1
	    movea.l (sp)+,a2      save ret addr
	    move    replreg(a3),-(sp)
	    move    widthreg(a3),-(sp)
	    move    htreg(a3),-(sp)
	    move    writecopy(a5),-(sp)
	    move    d0,replreg(a3)
	    move    d1,widthreg(a3)
	    move    d2,htreg(a3)
	    move    d3,writecopy(a5)
	    move    d3,writereg(a3)

	    jmp    (a2)
*
* restcrtstate: restores tile mover control regs
*
*           Uses:  a3
*
restcrtstate equ *
	    movea.l controladdr(a5),a3
restcrt1    btst   #4,status(a3)      wait for not busy
	    bne    restcrt1
	    move   4(sp),writecopy(a5)  restore copy variables
	    move   writecopy(a5),writereg(a3)  restore the registers
	    move   6(sp),htreg(a3)
	    move   8(sp),widthreg(a3)
	    move   10(sp),replreg(a3)

	    move.l (sp),8(sp)            move up return addr
	    addq   #8,sp
	    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
	 cmpi    #127,d0          check if in roman8 set
	 ble.s   notroman8
	 adda    #$4000,a1
notroman8 cmpi    #255,d0          see if char is in kana8 set
	 ble     notkana
	 adda    #$4000,a1        if so then adjust font base addr
notkana  lsl     #3,d0            get offset from font base addr
	 lea     0(a1,d0.w),a1  a1 = address of char in font storage
	 move    #64+128,d0       set repl rule to clear,down/rt
	 moveq   #-2,d1             we will move 2 tiles wide
	 moveq   #-4,d2             and 4 tiles high
	 moveq   #0,d3
	 move.b  highlight(a5),d3   get highlight byte
	 lsr     #4,d3              shift to get color mask
	 and     #7,d3
	 addq    #1,d3              protect planes we will move
	 bsr     savecrtstate
	 move.b  #0,(a0)
cclrb    btst    #4,status(a3)
	 bne     cclrb             wait for mover done
	 move    #3+64+128,replreg(a3) set repl rule to replace,down/rt
	 btst    #0,highlight(a5)   inverse video?
	 beq.s   ccharb             if not, skip next instruction
	 move    #12+64+128,replreg(a3) else set repl rule to invert
ccharb   not     d3                 complement to get disabled planes
	 move    d3,writecopy(a5)   make this the write prot reg
	 move    d3,writereg(a3)
	 move.b  (a1),(a0)          write the character
	 btst    #2,highlight(a5)     underline?
	 beq.s   cchar1             if not then skip next part
ccharc   btst    #4,status(a3)      wait for move done
	 bne     ccharc
	 adda    #15360,a0          point to last line of cell
	 not     d3                 get actual pen number in d3
	 move    #6,replreg(a3)     set repl reg to xor
	 moveq   #7,d1              we want to underline 8 bytes
cchard   move.b  d3,(a0)+           do the underline
	 dbra    d1,cchard
cchar1   bsr     restcrtstate
	 jmp     (a4)
*
*
*   cscrollup;
*
*   scrolls the screen up one line of alpha text (16 graphics lines)
*
cscrollup bsr     cursoroff
	  movea.l screen(a5),a0
	  movea.l a0,a1
	  adda    #16384,a0
	  move.w  #131+64,d0     set block mover for dn/rt moving
	  moveq   #0,d1          width=256 tiles
	  move    maxy(a5),d2    get lines in screen to move
	  lsl     #2,d2          convert to #tiles
	  neg     d2
	  moveq   #0,d3          use all planes
	  bsr     savecrtstate
	  move.b  (a0),(a1)
sucheck   btst    #4,status(a3)   a3 setup by savecrtstate
	  bne     sucheck
*
* Clear bottom line on screen
*
	  move    maxy(a5),d2
	  mulu    #16384,d2
	  adda.l  d2,a1           a1 now points to last line
	  move    #128+64+3,replreg(a3)
	  move    #0,widthreg(a3)
	  move    #-4,htreg(a3)
	  movea.l #clearl,a0
	  adda.l  screen(a5),a0
	  move.b  (a0),(a1)
bcheck    btst    #4,status(a3)
	  bne     bcheck
	  bsr     restcrtstate

	  bra     cursoron

*
*    cscrolldown
*
*    scrolls the screen down one text line
*
cscrolldown bsr     cursoroff
	    movea.l screen(a5),a0
	    move    maxy(a5),d0
	    mulu    #16384,d0
	    subq.l  #1,d0             bottom/rt corner of src
	    adda.l  d0,a0
	    movea.l a0,a1             pointed to by a1
	    adda    #16384,a0         point to 1 char row past a1
	    move.w  #131,d0           set repl rule, up/left move
	    moveq   #0,d1             assume 256 tile width
	    move    maxy(a5),d2       use maxy to get height
	    lsl     #2,d2             convert to #tiles
	    neg     d2
	    moveq   #0,d3             use all planes
	    bsr     savecrtstate
	    move.b  (a1),(a0)
sdcheck     btst    #4,status(a3)    a3 setup by savecrtstate
	    bne     sdcheck

	    movea.l screen(a5),a0
	    movea.l #clearl,a1
	    adda.l  a0,a1
	    move    #128+64+3,replreg(a3)  setup blank line move
	    move    #0,widthreg(a3)  setup widthreg
	    move    #-4,htreg(a3)  setup heightreg

	    move.b  (a1),(a0)
topcheck    btst    #4,status(a3)    a3 setup by savecrtstate
	    bne     topcheck
	    bsr     restcrtstate
	    bra     cursoron

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

cupdatecursor movea.l cursoraddr(a5),a1
	      movea.l (sp)+,a4     a4 = return addr
	      moveq   #0,d5
	      move    (sp)+,d5     d5 = y
	      move    (sp)+,d4     d4 = x
	      moveq   #3,d0
	      moveq   #0,d3
	      bsr     savecrtstate
	      lea     cursorhold(a5),a2    point to current contents
	      move.l  (a2)+,(a1)+          put current content back
	      move.l  (a2)+,(a1)
	      adda    #width-4,a1          adjust for next line
	      move.l  (a2)+,(a1)+
	      move.l  (a2),(a1)            current loc now restored
	      mulu    #16384,d5
	      add.l   #14336,d5   spaces you to line 15 of character for cursor
	      lsl     #3,d4
	      movea.l screen(a5),a0
	      adda    d4,a0
	      adda.l  d5,a0
	      move.l  a0,cursoraddr(a5)  a0 has new cursor address
	      lea     cursorhold(a5),a1  save location contents
	      moveq   #-1,d0             and put 1's in cursor loc
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)+
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)
	      adda    #width-4,a0
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)+
	      move.l  (a0),(a1)
	      move.l  d0,(a0)
	      bsr     restcrtstate

	      jmp     (a4)

*
*  cclear(xpos,ypos,nchars:shortint);
*    -- clears nchars starting at xpos, ypos
*    -- nchars + xpos must not exceed 128
*       no range checking is done
*

cclear        bsr     cursoroff
	      movea.l (sp)+,a4     a4 = return address
	      move    (sp)+,d1     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

	      lsl     #1,d1        convert #chars to #tiles
	      neg     d1           complement
	      move.w  #131+64,d0   move down/rt
	      moveq   #-4,d2       a row is 4 tiles high
	      moveq   #0,d3        use all planes
	      bsr     savecrtstate setup control regs

	      move.b  (a1),(a0)    do the clear
	      bsr     restcrtstate

cursoron      equ     *
	      moveq   #3,d0        use replace rule
	      moveq   #0,d3        enable all planes
	      bsr     savecrtstate
	      movea.l cursoraddr(a5),a0  a0 has cursor address
	      lea     cursorhold(a5),a1  save location contents
	      moveq   #-1,d0             and put 1's in cursor loc
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)+
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)
	      adda    #width-4,a0
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)+
	      move.l  (a0),(a1)
	      move.l  d0,(a0)
	      bsr     restcrtstate
	      rts


cursoroff     equ     *
	      movea.l cursoraddr(a5),a1
	      moveq   #3,d0
	      moveq   #0,d3
	      bsr     savecrtstate
	      lea     cursorhold(a5),a2    point to current contents
	      move.l  (a2)+,(a1)+          put current cursor back
	      move.l  (a2)+,(a1)
	      adda    #width-4,a1          adjust for next line
	      move.l  (a2)+,(a1)+
	      move.l  (a2),(a1)            current loc now restored
	      bsr     restcrtstate
	      rts

cshiftleft    moveq   #64,d3       set flag for down/rt move
	      moveq   #1,d0        get pointer to last line of screen
	      add     maxy(a5),d0
	      mulu    #16384,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,d1       get # chars in length to move
	      add     maxx(a5),d1  d1 now has # chars to move
	      tst     d3           check shift direction
	      bne.s   cshift2      if up/left must adjust pointers
	      move    d1,d2
	      lsl     #3,d2       d2 had #pixels to move
	      subq    #1,d2
	      adda    d2,a1       point to lower rt corners
	      adda    d2,a0
	      adda    #15360,a0
	      adda    #15360,a1
cshift2       lsl     #1,d1        d1 has # tiles in keybuffer length
	      neg     d1
	      move    #131,d0      set replacement rule
	      add     d3,d0        set direction flag in repl rule
	      moveq   #-4,d2       height is 4 tiles
	      moveq   #0,d3        use all planes
	      bsr     savecrtstate
	      move.b  (a1),(a0)    and go for it
	      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
	      moveq   #0,d3        set flag for up/left
	      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)+,d4     d4 = x offset in chars
	      lsl     #3,d4        d4 = 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,d7        save d0 temporarily
	      moveq   #3,d0        setup replacement rule
	      moveq   #0,d3        enable all planes
	      bsr     savecrtstate
	      move    d7,d0        restore d0
	      movea.l screen(a5),a0 a0 points to frame buffer start
	      adda.l  d1,a0         now points to correct row
	      adda    d4,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     cursoroff
	      moveq   #0,d6          set upscroll flag in d6
cscrollwindc  movea.l (sp)+,a4       a4 = return addr
	      move    (sp)+,d1       d1 = width in chars
	      lsl     #1,d1          d1 = width in tiles
	      move    (sp)+,d0       d0 = x offset of window in chars
	      lsl     #3,d0          d0 = x offset in pixels (bytes)
	      move    (sp)+,d2       d2 = ymax
	      move    (sp)+,d3       d3 = ymin
	      sub     d3,d2          d2 has # of char rows to move
	      lsl     #2,d2          now d2 has # of tile rows to move
	      movea.l screen(a5),a0  frame buffer addr in a0
	      mulu    #16384,d3      d3 = y offset in bytes
	      adda.l  d3,a0          a0 points to first row of window
	      adda    d0,a0          now add in x offset
	      tst     d6             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    #131+64,d0   set up repl rule, dn/rt moving
cscrollwin1   neg     d1             setup width reg
	      neg     d2             setup height reg
	      moveq   #0,d3          enable all planes
	      bsr     savecrtstate
	      move.b  (a1),(a0)      move the window
cscrollwin2   btst    #4,status(a3)    a3 setup by savecrtstate
	      bne     cscrollwin2
	      bsr     restcrtstate
	      move.l  a4,-(sp)        restack return addr
	      bra     cursoron    and fixup cursor

cscrollwindb  moveq   #0,d4           calculate first source row loc.
	      move    d2,d4           d4 = # tile rows to move
	      moveq   #12,d3
	      lsl.l   d3,d4           mpy by 4096 to get offset in FB
	      adda.l  d4,a0           add to prev. calculated pointer
	      suba    #width,a0       point to bottom row to move
	      move    d1,d5           d5 = # tiles in row
	      lsl     #2,d5           d5 = # pixels in row
	      adda    d5,a0
	      suba    #1,a0           a0 points to bot/rt pixel
	      movea.l a0,a1           a1 is source pointer
	      adda    #16384,a0       a0 points to destination
	      move    #131,d0         setup repl rule, up/left move
	      bra     cscrollwin1

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


cdbscrolll    bsr     cursoroff
	      moveq   #0,d6          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     #1,d1          width in tiles in d1
	      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     #2,d5          d5 = # tile rows to move
	      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     d6             check left/right flag
	      bne.s   cdbscroll2     if right, skip
	      adda    #8,a0          else src is to right of dest
	      move    #131+64,d0     setup replacement rule, dn/rt move
cdbscrollc    neg     d1             setup width reg
	      move    d5,d2
	      neg     d2             setup height reg
	      moveq   #0,d3          enable all planes
	      bsr     savecrtstate
	      move.b  (a0),(a1)      move a pixel row
cdbscroll5    btst    #4,status(a3)  check status
	      bne     cdbscroll5
	      bsr     restcrtstate
	      move.l  a4,-(sp)
	      bra     cursoron   finished!

cdbscroll2    move    d5,d4          d4 = #tiles of y direction
	      mulu    #4096,d4       offset to just past window
	      adda.l  d4,a0          a0 points to just past window
	      suba    #width,a0      point a0 to last pixel row
	      move    d1,d4          d4 = width in tiles
	      lsl     #2,d4          d4 = width in pixels
	      adda    d4,a0
	      suba    #1,a0          a0 points to bot/rt pixel of window
	      movea.l a0,a1          dest. will be a1
	      adda    #8,a1          one char row to rt
	      move    #131,d0        setup for up/left move
	      bra     cdbscrollc     goto common code



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

	      end
@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 720
	     page
*
*   GATORBOX bit-mapped alpha driver
*
*     Pascal 3.1 version by J. Schmidt
*
	 def     cscrollup,cscrolldown,cupdatecursor,cchar,cclear
	 def     cbuildtable,cshiftleft,cshiftright
	 def     cexchange,cscrollwindow,cursoron,cursoroff
	 def     cscrollwinddn,cdbscrolll,cdbscrollr
	 rorg.l 0
	 refa    crtgb,sysdevs
	 nosyms

clearl   equ     $CC000     blank pixel row offset

maxx        equ  crtgb-10
maxy        equ  crtgb-12
cursoraddr  equ  crtgb-4
highlight   equ  crtgb-18
cursorhold  equ  crtgb-34    content of current cursor location
controladdr equ  sysdevs-86
screen      equ  sysdevs-90
writecopy   equ  sysdevs-96


replreg  equ     $5006
widthreg equ     $5000
htreg    equ     $5002
writereg  equ    $6008      write protect reg
status   equ     $0002      secondary interrup reg has blockmover status
blinkrega equ    $6001      blink/enable reg A
blinkregb equ    $6005      blink/enable reg B


cmapbusy equ     $6803      color map busy
cmapptr  equ     $68B8      color map ptr reg  (word)
cmapred  equ     $69B2      color map red (word)
cmapgrn  equ     $69B4      color map green (word)
cmapblu  equ     $69B6      color map blue  (word)
cmapwrt  equ     $68F0      color map write trigger (word)



width        equ     1024
initoffset   equ      $23            offset to initialization offset
fontoffset   equ      $3B            offset to font info offset
frameoffset  equ      $5D            offset to frame buffer reg. offset
cmapidoff    equ      $57            offset to color map id offset
cmapinitoff  equ      $3F            offset to cmap 0 init region offset
framecnt     equ      $5B            offset of number of frames
*
*   cbuildtablei
*
cbuildtable movea.l  controladdr(a5),a0    get pointer to ROM start
	    movep    initoffset(a0),d1     form pointer to init block
	    movea.l  a0,a1                  make copy of ROM start addr
	    adda     d1,a1                  a1 points to init info now
	    jsr      ginitblock             call the initializatiion routine
	    moveq    #0,d1
	    movep    cmapidoff(a0),d0       get ptr to color map id reg
	    tst      d0                     if ptr=0, then use init region 0
	    beq.s    cinitclr
	    move.b   0(a0,d0),d1            get cmap id into d1
cinitclr    and      #3,d1                  look at least sig bits
	    lsl      #2,d1
	    move.b   cmapinitoff(a0,d1.w),d2  form cmap init block addr
	    lsl      #8,d2
	    move.b   cmapinitoff+2(a0,d1.w),d2
	    movea.l  a0,a1
	    adda     d2,a1                  a1 points to cmap init block
	    jsr      ginitblock
	    clr.l    screen(a5)             clear space for frame buffer addr
	    movep.w  frameoffset(a0),d0     get offset of frame buffer loc.
	    move.b   0(a0,d0),screen+1(a5)  form frame buffer addr
	    clr      writereg(a0)           enable all planes for write
	    clr      writecopy(a5)
	    moveq    #0,d0                  setup blink enable regs
	    moveq    #0,d1
	    move.b   framecnt(a0),d0        get number of frames
	    beq.s    creadfb                if zero we can use fb to find out
	    move     #$FFFF,d1              d1 will hold bit mask
	    moveq    #16,d2
	    sub      d0,d2                  d2 = shift count for d1
	    lsr      d2,d1                  d1 = blink/enable mask
	    bra.s    cinitblink
creadfb     movea.l  screen(a5),a1         use fb to get mask
	    move.b   #-1,(a1)
	    move.b   (a1),d1
cinitblink  move.b   d1,blinkrega(a0)      setup blink/enable regs
	    move.b   d1,blinkregb(a0)
	    movea.l  screen(a5),a1
	    move.w  #128+64,replreg(a0)  set repl rule to clear,down/rt
	    move.w  #0,widthreg(a0)
	    move.w  #1,htreg(a0)         clear all but last 4 pixel lines
	    move.b  #00,(a1)             clear the whole frame buffer
zcheck      btst    #4,status(a0)
	    bne     zcheck
	    move    #3,replreg(a0)

	    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 ?
	    bne.s   notroman
	    bsr     unpkroman             if so go unpack it
notroman    cmpi.b  #2,(a1)               is font = kana8 upper half?
	    bne.s   nextfont
	    bsr.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

	    lea     cmaptable,a1          initialize the color map
	    moveq   #0,d1                 clear some registers
	    move.l  d1,d2
	    move.l  d1,d3
	    move.l  d1,d4
cmaploop1   move.b  (a1)+,d2              get rgb values in d2-d4
	    move.b  (a1)+,d3
	    move.b  (a1)+,d4
	    bsr     cmapenter             stuff the color map entry
	    addq    #1,d1                 bump cmap pointer value
	    cmp     #16,d1                have we done 16 yet?
	    bne     cmaploop1             if not then continue
	    moveq   #-1,d2                set entries 16-255 to white
	    move.l  d2,d3
	    move.l  d2,d4
cmaploop2   bsr     cmapenter
	    addq    #1,d1
	    cmp     #256,d1                done with cmap init?
	    bne     cmaploop2

cmaploop3   btst     #2,cmapbusy(a0)        wait for color map not busy
	    bne      cmaploop3
	    moveq    #0,d1                  CHECK FOR NEREID COLOR MAP 6/85
	    movep    cmapidoff(a0),d0       get ptr to color map id reg
	    tst      d0                     if ptr=0, then use init region 0
	    beq.s    cinitclr2
	    move.b   0(a0,d0),d1            get cmap id into d1
cinitclr2   and      #3,d1                  look at least sig bits
	    bne.s    notnereid              if result<>0 then skip
	    moveq    #0,d0                  else set rgb regs to 0
	    move     d0,cmapred(a0)
	    move     0,d7                   delay for nereid SFB
	    move     d0,cmapgrn(a0)
	    move     0,d7                   delay for nereid SFB
	    move     d0,cmapblu(a0)

notnereid   move.l  screen(a5),cursoraddr(a5)  initialize cursor location
	    bsr     cursoron              turn it on
	    rts
*
*   misc utilities for initialization
*
*
unpkkana    moveq   #127,d3               kana8 upper half has 128 chars
	    movea.l #$C8000,a2            store at font storage + 256*128
	    subq    #1,d7                 count a found font
	    bra     unpackit

unpkroman   moveq   #127,d3               #chars to unpack-1
	    subq    #1,d7                 count a found font
	    movea.l #$C0000,a2            start at beginning of font storage
	    bsr.s   unpackit
	    moveq   #127,d3               now unpack second half of font
	    movea.l #$C4000,a2

unpackit    adda.l  screen(a5),a2
	    movea.l a2,a4                 a4 points to font char start addr
	    subq    #8,a4
unpackchar  moveq   #15,d5                unpack 16 rows/char
	    addq    #8,a4                 point to char storage start
	    movea.l a4,a2                 make the working copy
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
	    adda    #width-8,a2           adjust storage pointer
	    dbra    d5,unpackrow          and loop till rows in char done
	    dbra    d3,unpackchar         loop till all chars done
	    rts                           go look at next font

cmapenter   nop
	    btst    #2,cmapbusy(a0)       check for color map busy
	    bne     cmapenter             loop till bit is clear
	    move    0,d7                  delay for nereid SFB
	    move    d1,cmapptr(a0)        set pointer register
	    move    0,d7                  delay for nereid SFB
	    move.w  d2,cmapred(a0)        stuff the rgb regs
	    move    0,d7                  delay for nereid SFB
	    move.w  d3,cmapgrn(a0)
	    move    0,d7                  delay for nereid SFB
	    move.w  d4,cmapblu(a0)
	    move    0,d7                  delay for nereid SFB
	    move    d1,cmapwrt(a0)        hit the write trigger
*           nop                           removed SFB
	    rts                           done with cmap entry write


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
	    btst     #0,(a1)                is this a bit test block?
	    bne.s    ginitbtst              if so go handle it
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
ginit3      addq     #4,a2
ginit2      movea.l  a2,a1                  a1 points to new init block
	    bra      ginitblock             do the initialize
ginitdone   rts

ginitbtst   moveq    #0,d2                  handle bit test blocks here
	    move.b   2(a2),d2               d2 = bit # to test
ginittst2   move     (a3),d3                d3 = data word to test
	    btst     #0,(a2)                check for sense of test
	    bne.s    ginittst3              comp if waiting for 0
	    not      d3
ginittst3   btst     d2,d3                  check the bit
	    beq      ginittst2              if not 1 then loop
	    btst     #7,(a1)                was this last block?
	    bne      ginitdone              if so then return
	    bra      ginit3                 else do next block
*
*
cmaptable   equ      *                      initial color map contents (r,g,b)
	    dc.b     0,0,0                  0
	    dc.b     255,255,255            1
	    dc.b     255,0,0                2
	    dc.b     255,255,0              3
	    dc.b     0,255,0                4
	    dc.b     0,255,255              5
	    dc.b     0,0,255                6
	    dc.b     255,0,255              7
	    dc.b     0,0,0                  8
	    dc.b     204,187,51             9
	    dc.b     51,170,119             10
	    dc.b     136,102,170            11
	    dc.b     204,68,102             12
	    dc.b     255,102,51             13
	    dc.b     255,119,0              14
	    dc.b     221,136,68             15
*
*
* savecrtstate: preserve tile mover  state
*               Entry: d0= replacement rule
*                      d1= window width in tiles
*                      d2= window height in tiles
*                      d3= write protect
*               Uses:  a2,a3
*
savecrtstate equ *
	    movea.l controladdr(a5),a3
savestate1  btst   #4,status(a3)    wait for not busy
	    bne    savestate1
	    movea.l (sp)+,a2      save ret addr
	    move    replreg(a3),-(sp)
	    move    widthreg(a3),-(sp)
	    move    htreg(a3),-(sp)
	    move    writecopy(a5),-(sp)
	    move    d0,replreg(a3)
	    move    d1,widthreg(a3)
	    move    d2,htreg(a3)
	    move    d3,writecopy(a5)
	    move    d3,writereg(a3)

	    jmp    (a2)
*
* restcrtstate: restores tile mover control regs
*
*           Uses:  a3
*
restcrtstate equ *
	    movea.l controladdr(a5),a3
restcrt1    btst   #4,status(a3)      wait for not busy
	    bne    restcrt1
	    move   4(sp),writecopy(a5)  restore copy variables
	    move   writecopy(a5),writereg(a3)  restore the registers
	    move   6(sp),htreg(a3)
	    move   8(sp),widthreg(a3)
	    move   10(sp),replreg(a3)

	    move.l (sp),8(sp)            move up return addr
	    addq   #8,sp
	    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
	 cmpi    #127,d0          check if in roman8 set
	 ble.s   notroman8
	 adda    #$4000,a1
notroman8 cmpi    #255,d0          see if char is in kana8 set
	 ble     notkana
	 adda    #$4000,a1        if so then adjust font base addr
notkana  lsl     #3,d0            get offset from font base addr
	 lea     0(a1,d0.w),a1  a1 = address of char in font storage
	 move    #64+128,d0       set repl rule to clear,down/rt
	 moveq   #-2,d1             we will move 2 tiles wide
	 moveq   #-4,d2             and 4 tiles high
	 moveq   #0,d3
	 move.b  highlight(a5),d3   get highlight byte
	 lsr     #4,d3              shift to get color mask
	 and     #7,d3
	 addq    #1,d3              protect planes we will move
	 bsr     savecrtstate
	 move.b  #0,(a0)
cclrb    btst    #4,status(a3)
	 bne     cclrb             wait for mover done
	 move    #3+64+128,replreg(a3) set repl rule to replace,down/rt
	 btst    #0,highlight(a5)   inverse video?
	 beq.s   ccharb             if not, skip next instruction
	 move    #12+64+128,replreg(a3) else set repl rule to invert
ccharb   not     d3                 complement to get disabled planes
	 move    d3,writecopy(a5)   make this the write prot reg
	 move    d3,writereg(a3)
	 move.b  (a1),(a0)          write the character
	 btst    #2,highlight(a5)     underline?
	 beq.s   cchar1             if not then skip next part
ccharc   btst    #4,status(a3)      wait for move done
	 bne     ccharc
	 adda    #15360,a0          point to last line of cell
	 not     d3                 get actual pen number in d3
	 move    #6,replreg(a3)     set repl reg to xor
	 moveq   #7,d1              we want to underline 8 bytes
cchard   move.b  d3,(a0)+           do the underline
	 dbra    d1,cchard
cchar1   bsr     restcrtstate
	 jmp     (a4)
*
*
*   cscrollup;
*
*   scrolls the screen up one line of alpha text (16 graphics lines)
*
cscrollup bsr     cursoroff
	  movea.l screen(a5),a0
	  movea.l a0,a1
	  adda    #16384,a0
	  move.w  #131+64,d0     set block mover for dn/rt moving
	  moveq   #0,d1          width=256 tiles
	  move    maxy(a5),d2    get lines in screen to move
	  lsl     #2,d2          convert to #tiles
	  neg     d2
	  moveq   #0,d3          use all planes
	  bsr     savecrtstate
	  move.b  (a0),(a1)
sucheck   btst    #4,status(a3)   a3 setup by savecrtstate
	  bne     sucheck
*
* Clear bottom line on screen
*
	  move    maxy(a5),d2
	  mulu    #16384,d2
	  adda.l  d2,a1           a1 now points to last line
	  move    #128+64+3,replreg(a3)
	  move    #0,widthreg(a3)
	  move    #-4,htreg(a3)
	  movea.l #clearl,a0
	  adda.l  screen(a5),a0
	  move.b  (a0),(a1)
bcheck    btst    #4,status(a3)
	  bne     bcheck
	  bsr     restcrtstate

	  bra     cursoron

*
*    cscrolldown
*
*    scrolls the screen down one text line
*
cscrolldown bsr     cursoroff
	    movea.l screen(a5),a0
	    move    maxy(a5),d0
	    mulu    #16384,d0
	    subq.l  #1,d0             bottom/rt corner of src
	    adda.l  d0,a0
	    movea.l a0,a1             pointed to by a1
	    adda    #16384,a0         point to 1 char row past a1
	    move.w  #131,d0           set repl rule, up/left move
	    moveq   #0,d1             assume 256 tile width
	    move    maxy(a5),d2       use maxy to get height
	    lsl     #2,d2             convert to #tiles
	    neg     d2
	    moveq   #0,d3             use all planes
	    bsr     savecrtstate
	    move.b  (a1),(a0)
sdcheck     btst    #4,status(a3)    a3 setup by savecrtstate
	    bne     sdcheck

	    movea.l screen(a5),a0
	    movea.l #clearl,a1
	    adda.l  a0,a1
	    move    #128+64+3,replreg(a3)  setup blank line move
	    move    #0,widthreg(a3)  setup widthreg
	    move    #-4,htreg(a3)  setup heightreg

	    move.b  (a1),(a0)
topcheck    btst    #4,status(a3)    a3 setup by savecrtstate
	    bne     topcheck
	    bsr     restcrtstate
	    bra     cursoron

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

cupdatecursor movea.l cursoraddr(a5),a1
	      movea.l (sp)+,a4     a4 = return addr
	      moveq   #0,d5
	      move    (sp)+,d5     d5 = y
	      move    (sp)+,d4     d4 = x
	      moveq   #3,d0
	      moveq   #0,d3
	      bsr     savecrtstate
	      lea     cursorhold(a5),a2    point to current contents
	      move.l  (a2)+,(a1)+          put current content back
	      move.l  (a2)+,(a1)
	      adda    #width-4,a1          adjust for next line
	      move.l  (a2)+,(a1)+
	      move.l  (a2),(a1)            current loc now restored
	      mulu    #16384,d5
	      add.l   #14336,d5   spaces you to line 15 of character for cursor
	      lsl     #3,d4
	      movea.l screen(a5),a0
	      adda    d4,a0
	      adda.l  d5,a0
	      move.l  a0,cursoraddr(a5)  a0 has new cursor address
	      lea     cursorhold(a5),a1  save location contents
	      moveq   #-1,d0             and put 1's in cursor loc
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)+
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)
	      adda    #width-4,a0
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)+
	      move.l  (a0),(a1)
	      move.l  d0,(a0)
	      bsr     restcrtstate

	      jmp     (a4)

*
*  cclear(xpos,ypos,nchars:shortint);
*    -- clears nchars starting at xpos, ypos
*    -- nchars + xpos must not exceed 128
*       no range checking is done
*

cclear        bsr     cursoroff
	      movea.l (sp)+,a4     a4 = return address
	      move    (sp)+,d1     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

	      lsl     #1,d1        convert #chars to #tiles
	      neg     d1           complement
	      move.w  #131+64,d0   move down/rt
	      moveq   #-4,d2       a row is 4 tiles high
	      moveq   #0,d3        use all planes
	      bsr     savecrtstate setup control regs

	      move.b  (a1),(a0)    do the clear
	      bsr     restcrtstate

cursoron      equ     *
	      moveq   #3,d0        use replace rule
	      moveq   #0,d3        enable all planes
	      bsr     savecrtstate
	      movea.l cursoraddr(a5),a0  a0 has cursor address
	      lea     cursorhold(a5),a1  save location contents
	      moveq   #-1,d0             and put 1's in cursor loc
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)+
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)
	      adda    #width-4,a0
	      move.l  (a0),(a1)+
	      move.l  d0,(a0)+
	      move.l  (a0),(a1)
	      move.l  d0,(a0)
	      bsr     restcrtstate
	      rts


cursoroff     equ     *
	      movea.l cursoraddr(a5),a1
	      moveq   #3,d0
	      moveq   #0,d3
	      bsr     savecrtstate
	      lea     cursorhold(a5),a2    point to current contents
	      move.l  (a2)+,(a1)+          put current cursor back
	      move.l  (a2)+,(a1)
	      adda    #width-4,a1          adjust for next line
	      move.l  (a2)+,(a1)+
	      move.l  (a2),(a1)            current loc now restored
	      bsr     restcrtstate
	      rts

cshiftleft    moveq   #64,d3       set flag for down/rt move
	      moveq   #1,d0        get pointer to last line of screen
	      add     maxy(a5),d0
	      mulu    #16384,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,d1       get # chars in length to move
	      add     maxx(a5),d1  d1 now has # chars to move
	      tst     d3           check shift direction
	      bne.s   cshift2      if up/left must adjust pointers
	      move    d1,d2
	      lsl     #3,d2       d2 had #pixels to move
	      subq    #1,d2
	      adda    d2,a1       point to lower rt corners
	      adda    d2,a0
	      adda    #15360,a0
	      adda    #15360,a1
cshift2       lsl     #1,d1        d1 has # tiles in keybuffer length
	      neg     d1
	      move    #131,d0      set replacement rule
	      add     d3,d0        set direction flag in repl rule
	      moveq   #-4,d2       height is 4 tiles
	      moveq   #0,d3        use all planes
	      bsr     savecrtstate
	      move.b  (a1),(a0)    and go for it
	      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
	      moveq   #0,d3        set flag for up/left
	      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)+,d4     d4 = x offset in chars
	      lsl     #3,d4        d4 = 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,d7        save d0 temporarily
	      moveq   #3,d0        setup replacement rule
	      moveq   #0,d3        enable all planes
	      bsr     savecrtstate
	      move    d7,d0        restore d0
	      movea.l screen(a5),a0 a0 points to frame buffer start
	      adda.l  d1,a0         now points to correct row
	      adda    d4,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     cursoroff
	      moveq   #0,d6          set upscroll flag in d6
cscrollwindc  movea.l (sp)+,a4       a4 = return addr
	      move    (sp)+,d1       d1 = width in chars
	      lsl     #1,d1          d1 = width in tiles
	      move    (sp)+,d0       d0 = x offset of window in chars
	      lsl     #3,d0          d0 = x offset in pixels (bytes)
	      move    (sp)+,d2       d2 = ymax
	      move    (sp)+,d3       d3 = ymin
	      sub     d3,d2          d2 has # of char rows to move
	      lsl     #2,d2          now d2 has # of tile rows to move
	      movea.l screen(a5),a0  frame buffer addr in a0
	      mulu    #16384,d3      d3 = y offset in bytes
	      adda.l  d3,a0          a0 points to first row of window
	      adda    d0,a0          now add in x offset
	      tst     d6             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    #131+64,d0   set up repl rule, dn/rt moving
cscrollwin1   neg     d1             setup width reg
	      neg     d2             setup height reg
	      moveq   #0,d3          enable all planes
	      bsr     savecrtstate
	      move.b  (a1),(a0)      move the window
cscrollwin2   btst    #4,status(a3)    a3 setup by savecrtstate
	      bne     cscrollwin2
	      bsr     restcrtstate
	      move.l  a4,-(sp)        restack return addr
	      bra     cursoron    and fixup cursor

cscrollwindb  moveq   #0,d4           calculate first source row loc.
	      move    d2,d4           d4 = # tile rows to move
	      moveq   #12,d3
	      lsl.l   d3,d4           mpy by 4096 to get offset in FB
	      adda.l  d4,a0           add to prev. calculated pointer
	      suba    #width,a0       point to bottom row to move
	      move    d1,d5           d5 = # tiles in row
	      lsl     #2,d5           d5 = # pixels in row
	      adda    d5,a0
	      suba    #1,a0           a0 points to bot/rt pixel
	      movea.l a0,a1           a1 is source pointer
	      adda    #16384,a0       a0 points to destination
	      move    #131,d0         setup repl rule, up/left move
	      bra     cscrollwin1

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


cdbscrolll    bsr     cursoroff
	      moveq   #0,d6          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     #1,d1          width in tiles in d1
	      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     #2,d5          d5 = # tile rows to move
	      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     d6             check left/right flag
	      bne.s   cdbscroll2     if right, skip
	      adda    #8,a0          else src is to right of dest
	      move    #131+64,d0     setup replacement rule, dn/rt move
cdbscrollc    neg     d1             setup width reg
	      move    d5,d2
	      neg     d2             setup height reg
	      moveq   #0,d3          enable all planes
	      bsr     savecrtstate
	      move.b  (a0),(a1)      move a pixel row
cdbscroll5    btst    #4,status(a3)  check status
	      bne     cdbscroll5
	      bsr     restcrtstate
	      move.l  a4,-(sp)
	      bra     cursoron   finished!

cdbscroll2    move    d5,d4          d4 = #tiles of y direction
	      mulu    #4096,d4       offset to just past window
	      adda.l  d4,a0          a0 points to just past window
	      suba    #width,a0      point a0 to last pixel row
	      move    d1,d4          d4 = width in tiles
	      lsl     #2,d4          d4 = width in pixels
	      adda    d4,a0
	      suba    #1,a0          a0 points to bot/rt pixel of window
	      movea.l a0,a1          dest. will be a1
	      adda    #8,a1          one char row to rt
	      move    #131,d0        setup for up/left move
	      bra     cdbscrollc     goto common code



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

	      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.2
log
@Changes from Scott Bayes
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d147 1
d149 1
d190 1
d192 1
d194 1
d196 1
d198 1
d200 1
a200 1
	    nop
@


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
@@
