Metropoli BBS
VIEWER: scrsfky.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		(  )
*
* 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* )
  ' DispMenu.1
  ' ::			( *Hard key handler*   )
    kpNoShift #=casedrop
      ::
         DUP#<7 casedrpfls ( *Enable softkeys* )
         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
      ;
    2DROP 'DoBadKeyT
  ;
  TrueTrue		( *Key control flags* )
  {
    { "TOP" :: TakeOver JUMPTOP ; }
    { "BOT" :: TakeOver JUMPBOT ; }
    { "LEFT" :: TakeOver JUMPLEFT ; }
    { "RIGHT" :: TakeOver JUMPRIGHT ; }
    NullMenuKey
    { "QUIT" :: TakeOver TRUE ' LAM Exit STO ; }
  }
  ONEFALSE		( *1st row, no suspend* )
  ' LAM Exit		( *App exit condition* )
  ' ERRJMP		( *Error handler* )
  ParOuterLoop		( *Run the ParOuterLoop* )
  RECLAIMDISP		( *Resize and clear display* )
  ClrDAsOK		( *Redraw display* )
;
[ RETURN TO DIRECTORY ]