Metropoli BBS
VIEWER: scroll.s MODE: TEXT (ASCII)
*---------------------------------------------------------

*
* Include the header file KEYDEFS.H, which defines words
* like kcUpArrow at physical key numbers.
*
INCLUDE KEYDEFS.H
*
* Include the eight characters needed for binary download
*
ASSEMBLE
	NIBASC	/HPHP48-D/
RPL
*
* Begin the secondary
*
::
  RECLAIMDISP		( *Claim the alpha display* )
  ClrDA1IsStat		( *Temporarily disable clock* )
*                       ( *Try removing ClrDA1IsStat* )
  ZEROZERO		( #0 #0 )
  150 150 MAKEGROB	( #0 #0 150x150grob )
  XYGROBDISP		(  )
  TURNMENUOFF		( *Turn off menu line* )
*
* Draw diagonal lines.  Remember that LINEON requires
* requires #x2>#x1!
*
  ZEROZERO		( #x1 #y1 )
  149 149		( #x1 #y1 #x2 #y2 )
  LINEON		( *Draw line* )
  ZERO 149		( #x1 #y1 )
  149 ZERO		( #x1 #y1 #x2 #y2 )
  LINEON		( *Draw line* )
*
* Place text
*
  HARDBUFF
  75 50 "SCROLLING"	( HBgrob 75 150 "SCROLLING" )
  150 CENTER$3x5	( HBgrob )
  75 100 "EXAMPLE"      ( HBgrob 75 100 "EXAMPLE" )
  150 CENTER$3x5	( HBgrob )
  DROPFALSE		( FALSE )
  { LAM Exit } BIND	( *Bind POL exit flag* )
  ' NOP			( *No display action*  )
  ' ::			( *Hard key handler*   )
    kpNoShift #=casedrop
      ::
         kcUpArrow    ?CaseKeyDef
			  :: TakeOver SCROLLUP ;
         kcLeftArrow  ?CaseKeyDef
			  :: TakeOver SCROLLLEFT ;
	 kcDownArrow  ?CaseKeyDef
			  :: TakeOver SCROLLDOWN ;
         kcRightArrow ?CaseKeyDef
			  :: TakeOver SCROLLRIGHT ;
         kcOn	      ?CaseKeyDef
			  :: TakeOver
			     TRUE ' LAM Exit STO ;
         kcRightShift	#=casedrpfls
         DROP 'DoBadKeyT
      ;
    kpRightShift #=casedrop
      ::
         kcUpArrow    ?CaseKeyDef
			  :: TakeOver JUMPTOP ;
         kcLeftArrow  ?CaseKeyDef
			  :: TakeOver JUMPLEFT ;
	 kcDownArrow  ?CaseKeyDef
			  :: TakeOver JUMPBOT ;
         kcRightArrow ?CaseKeyDef
			  :: TakeOver JUMPRIGHT ;
         kcRightShift #=casedrpfls
         DROP 'DoBadKeyT
      ;
    2DROP 'DoBadKeyT
  ;
  TrueTrue		( *Key control flags* )
  NULL{}		( *No softkeys here*  )
  ONEFALSE		( *1st row, no suspend* )
  ' LAM Exit		( *App exit condition* )
  ' ERRJMP		( *Error handler* )
  ParOuterLoop		( *Run the ParOuterLoop* )
  TURNMENUON		( *Restore menu row* )
  RECLAIMDISP		( *Resize and clear display* )
  ClrDAsOK		( *Redraw display* )
;
[ RETURN TO DIRECTORY ]