* 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* )
;
