*****************************************************************************
* Modulname:	Lemming
* Modultype:	User level secondary
* Dest.Comp.:	HP48
* Language:	System RPL
* Author:	Detlef Mueller,Nibelungenweg 6,2000 Hamburg 56
* Interface:	LEM	( --> )
* Description:
* Edition History :
*	1.000	08-11-1991	DM	Alpha version
*	  001	09-19-1991	DM	Fix grob, smoth animation
*****************************************************************************

    TITLE	Lemming

    ASSEMBLE
	NIBASC	/HPHP48-E/	Bin. download header
*				GROB in RPLCOMP generates unusable
*				grob definitions. This is the workaround:
MKSGROB	MACRO			* x,y,gpatt - gpatt max. 80 nibbles
	CON(5)	=DOGROB
	CON(5)	15+(($1+7)/8)*$2*2
	CON(5)	$2
	CON(5)	$1
	NIBHEX	$3
MKSGROB	ENDM
    RPL

::
    CK0NOLASTWD				( *Std. entry* )
    ClrDA1IsStat			( *Suspend clock* )
    ZEROZERO TWELVE BLANKIT		( *Clr. part of DA1* --> #0 )
    GARBAGE				( *Force garbage collection* )
    BEGIN
	#1+				( *Inc. x* )
	{   ASSEMBLE			( *Lemming images* )
		MKSGROB 6,10,00C3C18381818181C181
		MKSGROB 7,10,82C1C18381C1C585C2C0
		MKSGROB 7,10,0041C18183C1C1E3C366
		MKSGROB 6,10,0081C3C38181C181E323
		MKSGROB 6,10,00C3C1C381818181C181
		MKSGROB 7,10,82C1C18381818585C2C0
		MKSGROB 7,10,0041C18183818183C366
		MKSGROB 6,10,0081C3C381818181E323
	    RPL
	}
	OVER SEVEN #AND #1+ NTHCOMPDROP	( *Get lem image*  #x --> #x g )
	HARDBUFF 3PICK FOUR		( #x g --> #x g hbg #x #4 )
	GROB!				( *Draw new lem* --> #x )
	DUP THREE #AND #2= IT		( *On every step ..* )
	::  THREE 400 setbeep		( *Generate tick* )
	;
	%.1 dowait			( *Slowdown - try to rem. this :*)
	GETTOUCH IT			( *Key pressed ?*)
	::  2DROP 123			( *Yes, signal exit* )
	;
	ATTN? IT			( *ATTN pressed ?* )
	::  DROP 123			( *Yes, signal exit* )
	;
	123 OVER#=			( *Stop loop at x = 123* )
    UNTIL DROP				( *Drop x* )
    ATTNFLGCLR FLUSHKEYS		( *Clr attn flag, key buffer* )
    ClrDAsOK				( *Signal redraw display* )
;