harbour-core/harbour/tests/working/debugger.prg

// Harbour debugger first outline

#include "box.ch"
#include "classes.ch"
#include "inkey.ch"

function Main()

   local nCursor := SetCursor( 0 )
   local lEnd := .f., nKey, nPopup
   local oMenu := TDbMenu():New( { " &File ", " &Locate ", " &View ", " &Run ",;
                                   " &Point ", " &Monitor ", " &Options ",;
                                   " &Window ", " &Help " } )

   CLS
   oMenu:Display()

   SET COLOR TO W+/BG
   @ 1, 0 CLEAR TO MaxRow() - 6, MaxCol()
   @ 1, 0, MaxRow() - 6, MaxCol() BOX B_DOUBLE
   @ MaxRow() -5, 0 CLEAR TO MaxRow() - 1, MaxCol()
   @ MaxRow() - 5, 0, MaxRow() - 1, MaxCol() BOX B_SINGLE
   @ MaxRow() - 5, ( MaxCol() / 2 ) - 4 SAY " Command "

   @ MaxRow(), 0 SAY ;
   "F1-Help F2-Zoom F3-Repeat F4-User F5-Go F6-WA F7-Here F8-Step F9-BkPt F10-Trace" COLOR "N/W"
   @ MaxRow(),  0 SAY "F1" COLOR "R/W"
   @ MaxRow(),  8 SAY "F2" COLOR "R/W"
   @ MaxRow(), 16 SAY "F3" COLOR "R/W"
   @ MaxRow(), 26 SAY "F4" COLOR "R/W"
   @ MaxRow(), 34 SAY "F5" COLOR "R/W"
   @ MaxRow(), 40 SAY "F6" COLOR "R/W"
   @ MaxRow(), 46 SAY "F7" COLOR "R/W"
   @ MaxRow(), 54 SAY "F8" COLOR "R/W"
   @ MaxRow(), 62 SAY "F9" COLOR "R/W"
   @ MaxRow(), 70 SAY "F10" COLOR "R/W"

   while ! lEnd

      nKey = InKey( 0 )

      do case
         case nKey == K_ESC
              if oMenu:nOpenPopup != 0
                 oMenu:ClosePopup( oMenu:nOpenPopup )
                 oMenu:nOpenPopup = 0
              else
                 lEnd = .t.
              endif

         case ( nPopup := oMenu:GetHotKeyPos( AltToKey( nKey ) ) ) != 0
              if oMenu:nOpenPopup != 0
                 oMenu:ClosePopup( oMenu:nOpenPopup )
                 oMenu:nOpenPopup = 0
              endif
              oMenu:ShowPopup( nPopup )

         case nKey == K_LEFT
              if oMenu:nOpenPopup != 0
                 oMenu:GoLeft()
              endif

         case nKey == K_RIGHT
              if oMenu:nOpenPopup != 0
                 oMenu:GoRight()
              endif

         otherwise
      endcase
   end

   SetColor( "W/N" )
   SetCursor( nCursor )
   CLS

return nil

CLASS TDBMENU  /* debugger menu */

   DATA   aPopups
   DATA   cClrHilite, cClrHotKey, cClrHotFocus, cClrPopup
   DATA   nOpenPopup             // zero if no popup is shown

   METHOD New( aItems )
   METHOD ClosePopup()
   METHOD Display()
   METHOD GetHotKeyPos( nKey )
   METHOD GoLeft()
   METHOD GoRight()
   METHOD ShowPopup( nPopup )

ENDCLASS

METHOD New( aItems ) CLASS TDBMENU

   local n, nCol := 0

   ::aPopups      = {}
   ::cClrHilite   = "N/BG"
   ::cClrHotFocus = "R/BG"
   ::cClrHotKey   = "R/W"
   ::cClrPopup    = "N/W"
   ::nOpenPopup   = 0

   for n = 1 to Len( aItems )
      AAdd( ::aPopups, TDbPopup():New( aItems[ n ], nCol ) )
      nCol += Len( StrTran( aItems[ n ], "&", "" ) )
   next

return Self

METHOD ClosePopup( nPopup ) CLASS TDBMENU

   if nPopup != 0
      @ 0, ::aPopups[ nPopup ]:nCol SAY ;
        StrTran( ::aPopups[ nPopup ]:cPrompt, "&", "" ) COLOR ::cClrPopup

      @ 0, ::aPopups[ nPopup ]:nCol + nAt := At( "&", ::aPopups[ nPopup ]:cPrompt ) - 1 SAY ;
        SubStr( ::aPopups[ nPopup ]:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
   endif

return nil

METHOD Display() CLASS TDBMENU

   local n, nAt

   @ 0, 0 SAY Space( MaxCol() + 1 ) COLOR ::cClrPopup
   DevPos( 0, 0 )
   SET COLOR TO N/W

   for n = 1 to Len( ::aPopups )
      @ 0, ::aPopups[ n ]:nCol SAY StrTran( ::aPopups[ n ]:cPrompt, "&", "" )
      @ 0, ::aPopups[ n ]:nCol + nAt := At( "&", ::aPopups[ n ]:cPrompt ) - 1 SAY ;
         SubStr( ::aPopups[ n ]:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
   next

return nil

METHOD GetHotKeyPos( cKey ) CLASS TDBMENU

   local n

   for n = 1 to Len( ::aPopups )
      if Upper( SubStr( ::aPopups[ n ]:cPrompt,;
         At( "&", ::aPopups[ n ]:cPrompt ) + 1, 1 ) ) == cKey
         return n
      endif
   next

return 0

return .f.

METHOD GoLeft() CLASS TDBMENU

   if ::nOpenPopup != 0
      ::ClosePopup( ::nOpenPopup )
      if ::nOpenPopup > 1
         ::ShowPopup( ::nOpenPopup -= 1 )
      else
         ::ShowPopup( ::nOpenPopup := Len( ::aPopups ) )
      endif
   endif

return nil

METHOD GoRight() CLASS TDBMENU

   if ::nOpenPopup != 0
      ::ClosePopup( ::nOpenPopup )
      if ::nOpenPopup < Len( ::aPopups )
         ::ShowPopup( ::nOpenPopup += 1 )
      else
         ::ShowPopup( ::nOpenPopup := 1 )
      endif
   endif

return nil

METHOD ShowPopup( nPopup ) CLASS TDBMENU

   local nAt

   @ 0, ::aPopups[ nPopup ]:nCol SAY ;
      StrTran( ::aPopups[ nPopup ]:cPrompt, "&", "" ) COLOR ::cClrHilite

   @ 0, ::aPopups[ nPopup ]:nCol + nAt := At( "&", ::aPopups[ nPopup ]:cPrompt ) - 1 SAY ;
     SubStr( ::aPopups[ nPopup ]:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotFocus

   ::aPopups[ nPopup ]:cBackImage := SaveScreen( 1, ::aPopups[ nPopup ]:nCol,;
      6, ::aPopups[ nPopup ]:nCol + 7 ) // including shadow areas

   // @ 1, ::aPopups[ nPopup ]:nCol, 5, ::aPopups[ nPopup ]:nCol + 5 BOX B_SINGLE ;
   //   COLOR ::cClrPopup

   ::nOpenPopup = nPopup

return nil

CLASS TDBPOPUP

   DATA nCol
   DATA cPrompt
   DATA cBackImage

   METHOD New( cPrompt, nCol )

ENDCLASS

METHOD New( cPrompt, nCol ) CLASS TDBPOPUP

   ::nCol    = nCol
   ::cPrompt = cPrompt

return Self

static function AltToKey( nKey )

   local nIndex := AScan( { K_ALT_A, K_ALT_B, K_ALT_C, K_ALT_D, K_ALT_E, K_ALT_F,;
                            K_ALT_G, K_ALT_H, K_ALT_I, K_ALT_J, K_ALT_K, K_ALT_L,;
                            K_ALT_M, K_ALT_N, K_ALT_O, K_ALT_P, K_ALT_Q, K_ALT_R,;
                            K_ALT_S, K_ALT_T, K_ALT_U, K_ALT_V, K_ALT_W, K_ALT_X,;
                            K_ALT_Y, K_ALT_Z }, nKey )

      if nIndex > 0
         cKey := SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 )
      else
         cKey = ""
      endif

return cKey