* GREYSCAL VIEWING UTILITY, RANDY DING, 11/1993
* TAKES A 131x64n GROB WHERE N IS NUMBER OF FRAMES (SHADES OF GREY)
* IF 2 FRAMES, IT IS TAKEN AS A 3 SHADES OF GREY ENCODED GROB
* IF 3 FRAMES, IT IS TAKEN AS A 7 SHADES OF GREY ENCODED GROB
* NOTE 4 FRAME, 11 SHADES OF GREY ENCODED GROB IS NOT IMPLEMENTED (YET)
* ANY NUMBER OF FRAMES OTHER THAN 2 OR 3 WILL BE DISPLAYED IS A
*   RAPID SEQUENCE OF FRAMES, GREY SCALE WORKS WELL UP TO ABOUT 11 FRAMES!
* IMPORTANT, THE BEST WAY TO DESIGN FRAMES SEQUENCES IS FROM LIGHTEST
* TO DARKEST OR THE OTHER WAY AROUND, AS LONG AS THEY ARE IN ORDER,
* AND IT IS BETTER TO USE ODD NUMBER OF FRAMES.
* WHEN NUMBER OF FRAMES IS >= FIVE AND THERE ARE AN ODD NUMBER OF FRAMES
* THE PROGRAM WILL INTERLACE THEM, THAT IS TO DISPLAY EVERY OTHER ONE
* EACH PASS AND THEREBY REDUCE THE FLICKERING.

ASSEMBLE
	   NIBASC  /HPHP48-E/
RPL

::
 CK1NOLASTWD
 CK&DISPATCH1
 TWELVE 		       ( *grob object* )
 ::
  SKIP
  $ "v1.1 11/93 R Ding"
  DUPGROBDIM		       ( *must be 131 x 64*n grob* )
  BINT_131d #<> SWAP
  SIXTYFOUR		       ( *calculate number of frames* )
  #/			       ( *grobYsize / 64 -> remain, quotient* )
  SWAP
  #0<>			       ( *if remainder <> 0 then bad* )
  ROT OR ITE
  DROP			       ( *drop #frames and skip code if bad* )
  CODE

* only 1 of the following flag bits will be set at a time
:ILACE	   EQU	   0	       interlace flag bit in ST reg
:WT21	   EQU	   1	       2-1 frame weighting flag bit in ST reg
:WT421	   EQU	   2	       4-2-1 frame weighting flag bit in ST reg

DOGREY	   GOSBVL  =POP#       pop number of frames from RPL stack
	   R1=A.F  A	       save number of frames
	   GOSBVL  =SAVPTR     save registers
	   INTOFF	       totally disable keyboard interrupts
	   ST=0    15	       ''
	   A=DAT1  A	       D1 -> grob object now on top of stack
	   C=0	   A
	   LC(2)   20	       skip 20 nib prolog
	   A=A+C   A
	   R0=A.F  A	       save pointer to data grob first line
	   ?ABIT=0 0	       even address?
	   GOYES   :EVEN       skip if grob data is allready byte alligned

	   LC(1)   #C	       1100b, [disp on: b3] & [offset: b2 b1 b0]
	   D0=(5)  #00100      display bit offset address
	   DAT0=C  1	       shift display left 4 pixels
	   D0=(2)  #25	       line byte offset addr, nibs skipped per line
	   LC(3)   #FFE        signed number with bit 0 ignored
	   DAT0=C  X	       make byte offset = -2 nibs (1 byte)

:EVEN	   D0=(5)  #128        display line counter addr
	   D1=(5)  #120        display start addr
	   LC(2)   63
	   DAT0=C  B	       make line counter 63

	   ST=0    :ILACE      make flag bit = 1 if interlacing required
	   ST=0    :WT21       = 1 if only 2 frames, 2-1 weighting
	   ST=0    :WT421      = 1 if 3 frames, 4-2-1 weighting
	   A=R1.F  B	       recall number of frames
	   LC(2)   2
	   ?A#C    B
	   GOYES   :NOWT21
	   ST=1    :WT21       2-1 weighted frames if 2
	   GOTO    :STOFRAM
:NOWT21    LC(2)   3
	   ?A#C    B
	   GOYES   :NOWT421
	   ST=1    :WT421      4-2-1 weighted frames if 3
	   LA(2)   #32	       special bit sequence for interlacing 4-2-1
	   GOTO    :STOFRAM
:NOWT421   ?ABIT=0 0	       don't interlace if even # of frames
	   GOYES   :NOLACE
	   LC(2)   5
	   ?A<C    B	       don't interlace if less than 5 frames
	   GOYES   :NOLACE
	   ST=1    :ILACE
:NOLACE    A=A-1   B	       decr # frames, counts thru 0
:STOFRAM   R1=A.F  B

:MAIN	   C=R1.F  B	       #frames-1 or 4-2-1 interlacing bit sequence
	   D=C	   B
:MAIN1	   A=R0.F  A	       recall pointer to data, first frame
	   B=A	   A

:WAIT	   ?ST=0   :ILACE      test interlace flag
	   GOYES   :WAIT0
	   D=D+1   XS	       comp bit 8, the skip flag for interlacing
	   C=D	   XS
	   ?CBIT=0 8	       when interlacing, display every other frame
	   GOYES   :NEXT
:WAIT0	   A=DAT0  B	       wait for display refresh to be completed
	   ?ABIT=1 5	       line counter decriments from 3F to 0
	   GOYES   :WAIT0
:WAIT1	   A=DAT0  B	       waiting for bit 5 transition from 0 to 1
	   ?ABIT=0 5
	   GOYES   :WAIT1

	   A=B	   A
	   DAT1=A  A	       change screen start address

	   C=0	   A	       read keyboard
	   LC(3)   #1FF
	   OUT=C
	   GOSBVL  =CINRTN
	   ?C#0    A
	   GOYES   :EXIT       exit if key down
	   OUT=C	       stop reading keyboard

:NEXT	   ?ST=1   :WT421
	   GOYES   :DO421
	   D=D-1   B
	   GOC	   :GOMAIN     repeat frame sequence from top
	   ?ST=1   :ILACE
	   GOYES   :NEXT1      ignore weighting flag if interlacing
	   ?ST=0   :WT21
	   GOYES   :NEXT1      no 2-1 weighting
	   ?D#0    B	       repeat first frame again, 2 weighted
	   GOYES   :GOWAIT
:NEXT1	   LC(5)   64*34       nibs in one 131x64 grob, 34 nibs per line
	   B=B+C   A	       adjust pointer to next frame
:GOWAIT    GOTO    :WAIT
:DO421	   SB=0
	   DSRB.F  B
	   ?SB=0
	   GOYES   :NOSB421
	   GOTO    :NEXT1
:NOSB421   ?D=0    B
	   GOYES   :GOMAIN     restart sequence from top
	   GOTO    :MAIN1      don't reset interlace sequence counter
:GOMAIN    GOTO    :MAIN

:EXIT	   C=0	   X	       stop reading keyboard
	   OUT=C
	   LA(2)   63-8        here assuming menu row was originally on
	   DAT0=A  B	       reset line counter
	   GOSBVL  =D0->Row1   get original display address
	   AD0EX
	   DAT1=A  A	       reset display address
	   ?ABIT=0 0	       check for even address
	   GOYES   :EXITEVEN
	   LA(1)   #C	       1100b, [disp on: b3] & [offset: b2 b1 b0]
	   LC(3)   #FFE        signed number with bit 0 ignored
	   GOTO    :EXIT01
:EXITEVEN  LA(1)   #8
	   LC(3)   #0
:EXIT01    D1=(2)  #0	       reset bit offset
	   DAT1=A  1
	   D1=(2)  #25	       reset line byte offset
	   DAT1=C  X
	   INTON	       enable keyboard interrupts
	   ST=1    15	       ''
	   GOVLNG  =GETPTRLOOP recall registers then LOOP
  ENDCODE
  DROP			       ( *grob* )
 ;			       ( *end first dispatch* )

* begin second dispatch, RFU packed grob character string

 THREE			       ( *string object* )
 ::
  CODE			       ( *RFU code, taken apart by rpl48* )
       GOSBVL  =SAVPTR	       ( *and modified to work on the GX* )
       GOSBVL  =GARBAGECOL
       GOSBVL  =GETPTR
       C=DAT1  A
       D1=C
       A=DAT1  A
       LCHEX   02A2C
       ?C#A    A
       GOYES   LBC362 +00026
       D1=D1+  5
       A=DAT1  A
       LCHEX   0000F
       ?C>A    A
       GOYES   LBC362 +00014
       D1=D1+  5
       A=DAT1  A
       LCHEX   24652
       ?C=A    A
       GOYES   LBC366 +00006
LBC362 GOTO    LBC55F +001FC
LBC366 D1=D1+  5
       GOSBVL  =ROOM
       A=DAT1  A
       D1=D1+  5
       C=C-A   A
       GONC    LBC37F +00006
LBC37B GOTO    LBC554 +001D8
LBC37F C=C-CON A,10
       GOC     LBC37B -0000B
       CD1EX
       RSTK=C
       C=A     A
       RSTK=C
       GOSBVL  =CREATETEMP
       GOSBVL  =D1=DSKTOP  *	    changed by Randy D. 9/2/93
*	D1=(5)	#70579
*	C=DAT1	A
*	D1=C
       CD0EX
       DAT1=C  A
       D1=C
       C=RSTK
       R2=C.F  A
       C=RSTK
       R3=C.F  A
       GOSUB   LBC3D6 +00014
       ST=0    10
       GOSBVL  =GETPTR
       A=DAT0  A
       D0=D0+  5
       PC=(A)
LBC3D6 C=R3.F  A
       D0=C
       D=0     X
LBC3E2 D=D-1   XS
       GONC    LBC3F9 +00013
       LCHEX   700
       D=C     XS
       C=DAT0  B
       D=C     B
       D0=D0+  2
LBC3F9 D=D+D   B
       GOC     LBC403 +00006
       GOTO    LBC493 +00093
LBC403 LCHEX   04
       GOSUB   LBC524 +00119
       ?A#0    B
       GOYES   LBC464 +00056
       LCHEX   05
       GOSUB   LBC524 +0010C
       ?A=0    B
       GOYES   LBC428 +0000D
       LCHEX   1F
       A=A+C   B
       GOTO    LBC464 +0003F
LBC428 LCHEX   5E
LBC42C A=DAT0  B
       DAT1=A  1
       D0=D0+  1
       D1=D1+  1
       C=C-1   B
       GONC    LBC42C -00011
       A=R2.F  A
       LCHEX   0005F
       A=A-C   A
       GOC     LBC460 +00011
       ?A=0    A
       RTNYES
       R2=A.F  A
       GOTO    LBC3E2 -0007B
LBC460 GOTO    LBC55F +000FE
LBC464 B=A     B
       B=B-1   B
LBC46A C=DAT0  B
       DAT1=C  1
       D0=D0+  1
       D1=D1+  1
       B=B-1   B
       GONC    LBC46A -00011
       C=R2.F  A
       C=C-A   A
       GOC     LBC460 -00026
       ?C=0    A
       RTNYES
       R2=C.F  A
LBC493 LCHEX   02
       GOSUB   LBC524 +00089
       ?A#0    B
       GOYES   LBC4AE +00010
       LCHEX   04
       GOSUB   LBC524 +0007C
       A=A+CON B,8
LBC4AE A=A+CON B,4
       R0=A.F  A
       LCHEX   07
       GOSUB   LBC524 +00062
       CD0EX
       R3=C.F  A
       C=R0.F  B
       B=C     B
       A=A+1   A
       CD1EX
       D1=C
       C=C-A   A
       D0=C
       B=B-1   B
LBC4E4 C=DAT0  B
       DAT1=C  1
       D0=D0+  1
       D1=D1+  1
       B=B-1   B
       GONC    LBC4E4 -00011
       C=R2.F  A
       A=R0.F  A
       C=C-A   A
       GOC     LBC520 +0001A
       ?C=0    A
       RTNYES
       R2=C.F  A
       C=R3.F  A
       D0=C
       GOTO    LBC3E2 -0013B
LBC520 GOTO    LBC55F +0003E
LBC524 B=C     B
       A=0     A
LBC529 A=A+A   B
       D=D-1   XS
       GONC    LBC543 +00013
       LCHEX   700
       D=C     XS
       C=DAT0  B
       D=C     B
       D0=D0+  2
LBC543 D=D+D   B
       GONC    LBC54C +00005
       A=A+1   B
LBC54C B=B-1   B
       GONC    LBC529 -00027
       RTN
LBC554 LCHEX   04FBB
       GOTO    LBC566 +0000A
LBC55F LCHEX   18CA7
LBC566 RSTK=C
       ST=0    10
       GOSBVL  =GETPTR
       RTN
  ENDCODE
  DUPTYPEGROB?
  NOTcase DROP
  DUPGROBDIM		       ( *must be 131 x 64*n grob* )
  BINT_131d #<> SWAP
  SIXTYFOUR		       ( *calculate number of frames* )
  #/			       ( *grobYsize / 64 -> remain, quotient* )
  SWAP
  #0<>			       ( *if remainder <> 0 then bad* )
  ROT OR ITE
  DROP			       ( *drop #frames and skip code if bad* )
  CODE
	   GOTO    DOGREY
  ENDCODE
  DROP			       ( *grob* )
 ;			       ( *end second dispatch* )
;