* Grey Scale Animator -- 4 Shades of Grey (128x56) * version 0 * Randy Ding Jan 1994 * * Don't Laugh! \|-) * * ( grob string --> ) * string 42 chars or less, anything larger will be truncated * string will be displayed and circular rotated left in menu row * * (+) and (-) keys for speed adjustment during animation. * starts out at level 3, adjustable from 0..7, 0 is fastest * * grob format: * size must be 128 x 112n where n is number of slides * each slide must be a 2 frame 4 shades of grey encoded grob * this means each frame is 128 x 56, 2 frames per slide * first frame of slide is 2 weighted, second frame is 1 weighted * for shade intensity * 3 leftmost columns should be blank because these would also show * up on the rightmost 3 colums, due to the grob being 128 instead of 131 * the program senses the number of slides by the 'y' size of the grob * size errors of the grob will exit, droping objects and no error messages * * Note: This strange grob config was chosen to help keep memory usage * by data to a min. I believe 16 slides along with the animator * will fit in a 32K machine if the memory is completely clear * with LASTSTK is disabled. * * - drop me a line with any questions * - Email: randyd@csd4.csd.uwm.edu * - Phone: (414) 762-3383 [home] or (414) 764-4342 [message] ASSEMBLE NIBASC /HPHP48-E/ RPL :: CK2NOLASTWD CK&DISPATCH1 # C3 ( *2: grob 1: string --> * ) :: FORTYTHREE 1_#1-SUB$ ( *truncate anything over 42 chars* ) BEGIN DUPLEN$ FORTYTWO #< WHILE APPEND_SPACE ( *append spaces until 42 chars long* ) REPEAT $>GROB ( *must be 42 chars* ) OVER GROBDIM # 80 ( *width=128?* ) #<> case 3DROP ( *bad, drop height and 2 grobs then exit*) # 70 ( *calculate number of slides* ) #/ ( *grobYsize / 112 -> remain, quotient* ) SWAP #0<> ( *if remainder <> 0 then bad* ) case 3DROP ( *drop #slides and 2 grobs then exit* ) CODE * The following code is tight on stack levels. Uses all eight. * Do not run this code without doing INTOFF and ST=0 15 first. GOSBVL =POP# pop # of frames from stack GOSBVL =SAVPTR save registers INTOFF totally disable keyboard interrupts ST=0 15 '' ?A#0 B GOYES :FRNOT0 GOTO :EXITNOW exit if 00 frames :FRNOT0 A=A-1 B -1 for counting thru 0 LC(3) #300 inital speed setting, goes to R0(15) C=A B # frames goes to R0(14-13) CSRC CSRC CSRC R0=C GOSUB :KEYUP? wait until key released A=DAT1 A -> grob object on stack level 1 C=0 A R2=C.F A init y line to rotate in menu grob LC(2) 20 A=A+C A skip 20 nib prolog R3=A.F A save pointer to menu grob data first line D1=D1+ 5 A=DAT1 A -> grob object on stack level 2 A=A+C A skip 20 nib prolog R0=A.F A save pointer to grey_amim data 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) #100 display bit offset address DAT0=C 1 shift display left 4 pixels LC(3) #FFC signed number with bit 0 ignored GOTO :ODDEVEN :EVEN LC(3) #FFE :ODDEVEN D0=(5) #125 line byte offset addr, nibs skipped per line DAT0=C X set byte offset D0=(5) #128 display line counter addr D1=(5) #120 display start addr ST=0 0 init key repeat flag :MAIN C=R0.F A rcl saved pointer to data grob line 1 B=C A C=R0 get # slides from R0(14-13) CSLC CSLC CSLC D=C B slide counter in D(B) :SLIDELOOP C=B A R1=C.F A save pointer to current slide C=R0.F S read speed, 0 fast, 7 slow CSLC put speed (0..7) from R0(S) in C(B) LA(2) 7 mask 0..7 A=A&C B C=0 A LC(1) 7 C=C-A B reverse order, 0 is now slowest, 7 is fastest C=C+C B mult by 4, the number of nibs in GOSUB instr. C=C+C B A=PC :GETPC1 A=A+C A LC(5) (:SLOWEST)-(:GETPC1) A=A+C A PC=A goto GOSUB below for desired anim. speed :SLOWEST GOSUB :DO1SLIDE GOSUB :DO1SLIDE GOSUB :DO1SLIDE GOSUB :DO1SLIDE GOSUB :DO1SLIDE GOSUB :DO1SLIDE GOSUB :DO1SLIDE GOSUB :DO1SLIDE D=D-1 B GONC :SLIDELOOP GOC :MAIN :DO1SLIDE C=0 A LC(3) #1FF read keyboard OUT=C GOSBVL =CINRTN ?C#0 A GOYES :KEYDOWN ST=0 0 flag to prevent key repeat GOTO :SKIPKEY :KEYDOWN LA(3) 1 some key was pressed C=A X 1 is row for (+) key OUT=C GOSBVL =CINRTN ?C#A X test for (+) key in column 1 GOYES :NOTPLUS ?ST=1 0 don't repeat keys GOYES :SKIPKEY ST=1 0 set repeat flag C=R0.F S decr speed, 0 is fastest ?C=0 S GOYES :SKIPKEY don't wrap around C=C-1 S R0=C.F S GOTO :SKIPKEY :NOTPLUS LC(3) 2 2 is row for (-) key OUT=C GOSBVL =CINRTN ?C#A X test for (-) key in column 1 GOYES :EXIT something other than (+) or (-), exit program ?ST=1 0 don't repeat keys GOYES :SKIPKEY ST=1 0 set repeat flag C=R0.F S incr speed, 7 is slowest C=C+1 S A=C S A=A+A S ?A=0 S GOYES :SKIPKEY don't wrap around R0=C.F S :SKIPKEY C=0 A OUT=C C=R1.F A B=C A GOSUB :NXTFRAME1 GOSUB :TWOWAIT GOSUB :NEXTFRAME GOSUB :ONEWAIT :NEXTFRAME LA(5) 32*56 B=B+A A :NXTFRAME1 A=B A DAT1=A A change screen start address RTN :TWOWAIT GOSUB :ONEWAIT :ONEWAIT GOSUB :DOMENUROW :ONEWAIT0 A=DAT0 B ?ABIT=1 5 GOYES :ONEWAIT0 GOSUB :DOMENUROW :ONEWAIT1 A=DAT0 B ?ABIT=0 5 GOYES :ONEWAIT1 RTN :EXIT 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 :EXITNOW GOSUB :KEYUP? INTON enable keyboard interrupts ST=1 15 '' GOVLNG =GETPTRLOOP recall registers then LOOP :KEYUP? C=0 A LC(3) #1FF read keyboard OUT=C GOSBVL =CINRTN ?C#0 A GOYES :KEYUP? loop until key released OUT=C stop reading keyboard RTN * R2 = y line, when = 8 do a memory move from menu data to menu grob * R3 = ptr to menu data * R4 = D0 save * alters A, C :DOMENUROW CD0EX R4=C.F A save D0 C=0 A C=R2.F B rcl y line to rotate, 8 = move to menu grob LA(2) 8 ?C>=A B GOYES :MENUMOVE C=C+C A C=C* 64 nibs per line C=C+C A CSL A A=R3.F A pointer to menu grob data A=A+C A D0=A GOSUB :ROLWLINE C=R2.F B C=C+1 B R2=C.F B C=R4.F A D0=C RTN :MENUMOVE C=0 A R2=C A reset y line counter to 0 C=R4.F A D0 save GOSBVL =CSLW5 make room to save D1 C=R3.F A -> data CD1EX D1 -> data R4=C GOSBVL =D0->Sft1 D0 -> menu grob P= 16-8 move 8 rows :MOVELOOP GOSUB :MOVE1 GOSUB :MOVE1 A=DAT1 B DAT0=A B D0=D0+ 2 D1=D1+ 16 D1=D1+ 16 P=P+1 GONC :MOVELOOP C=R4 D0 and D1 save D1=C GOSBVL =CSRW5 D0=C RTN :MOVE1 A=DAT1 W DAT0=A W D0=D0+ 16 D1=D1+ 16 RTN * rotate 64 nib line left with wrap around * D0 -> start of row to rotate * uses Areg and Creg, exits with D0 -> start of next line :ROLWLINE LA(1) 8 or mask for turning on msb when wraping 1 bit ASRC GOSUB :D0ADD64 rotate last word first, then work to the left SB=0 GOSUB :ROLWSUB bit-rotate four 16 nib words in line GOSUB :ROLWSUB GOSUB :ROLWSUB GOSUB :ROLWSUB ?SB=0 GOYES :D0ADD64 exit, pointing to next line GOSUB :D0ADD48 wrap the last bit around C=DAT0 W GOSUB :ROLWSUB0 GOTO :D0ADD16 exit, pointing to next line :ROLWSUB D0=D0- 16 back up one word C=DAT0 W ?SB=0 check incomming bit GOYES :ROLWSUB1 SB=0 CSRB outgoing bit -> SB :ROLWSUB0 C=C!A S GOTO :ROLWSUB2 :ROLWSUB1 CSRB " :ROLWSUB2 DAT0=C W RTN :D0ADD64 D0=D0+ 16 :D0ADD48 D0=D0+ 16 :D0ADD32 D0=D0+ 16 :D0ADD16 D0=D0+ 16 RTN ENDCODE 2DROP ( *grob grob, #frames bint poped allready* ) ; ( *dispatch* ) ;