!*! Updated on 16-Dec-92 at 1:30 AM by James A. Jarboe I V; edit time: 0:10:03
!****************************************************************************
!
! SCROLL.BAS - Shows usage of a fancy ESP screen scrolling box.
!
!****************************************************************************
! Uses:
! TOOLBZ.SBR -> On AMUS Network
! TOOLBZ.BSI -> On AMUS Network
! SCROLL.SCR -> On AMUS Network
! SCROLA.SCR -> On AMUS Network
!
++include SYSSTD.BSI ! Include Standard ESP stuff
++include TOOLBZ.BSI ! Include TOOLBZ.SBR values.
MAP1 SCROLL$, S, 34 ! Scroll Screen Name.
MAP1 SCROLL'SCREEN, X, 5000 ! Scroll Screen buffer.
MAP1 SCROLL'CHAR, F, 6 ! Scroll Screen Character value.
MAP1 SCROLL'FIELD, F, 6 ! Scroll Screen Field Number.
MAP1 SCROLL'TITLE$, S, 80 ! Scroll Title
MAP1 SCROLL'UP'AR, F, 6 ! Scroll Screen Up arrow field number.
MAP1 SCROLL'DN'AR, F, 6 ! Scroll Screen Down arrow field number.
MAP1 SCROLL'MAX, F, 6 ! Maximum number in Array.
MAP1 SCROLL'CURRENT,F, 6 ! Current location in Array.
MAP1 SCROLL'WINDOW, F, 6 ! Size of Scroll Window Items.
MAP1 SCROLL'ARRAY(20), S, 20 ! Scroll Array.
MAP1 ESP'HOME, F, 6, 30 ! Define CTRL-^
MAP1 ESP'END, F, 6, 5 ! Define CTRL-E
! Properly initialize terminal.
!
XCALL INITRM, "Scroll Test","By James A. Jarboe IV"
! Fetch Needed Screens.
!
xcall FETCH, "SCROLA", SCREEN, X
if X goto FETCH'ERROR
SCROLL$ = "SCROLL"
xcall FETCH, SCROLL$, SCROLL'SCREEN, X
if X goto FETCH'ERROR
! Properly open First Screen.
!
xcall OPNSCR, SCREEN
CHAR = ESP'BEGLIN ! Preset Character.
FIELD = 1 ! Preset Field.
ESP'FLSSEL = ESP'FLSDEC+asc(".")
! Get Screen input.
!
GTSCR:
XCALL GTSCR, SCREEN, CHAR, FIELD, ESP'FLSSEL
if (CHAR and 255) = ESP'MENU goto QUIT
if (CHAR and 255) = ESP'EXECUTE goto QUIT
if (CHAR and 255) = ESP'F9 call F9'SCROLL
goto GTSCR
QUIT:
xcall CLSSCR, SCREEN ! Properly close screen.
xcall INITRM ! Properly close terminal.
end ! Exit.
! Process F9.
!
F9'SCROLL:
! Preset Needed variables for Scrolling window.
!
SCROLL'WINDOW = 5 ! Scroll depth.
SCROLL'MAX = 20 ! Maximum in array.
SCROLL'CURRENT = 1 ! Current position in array.
SCROLL'TITLE$ = "ESP Screen Scroll" ! Title.
! Fill array padded with spaces.
!
for X = 1 to SCROLL'MAX
SCROLL'ARRAY(X) = SCV(X)+SPACE$(20)
next X
! Call the scrolling routine.
!
CALL SCROLL'SCREEN
! Process what we got.
!
XCALL GETVAL, SCROLL'SCREEN, SCROLL'FIELD, X$
XCALL SETVAL, SCREEN, 1, X$, SCROLL'FIELD, SCROLL'CURRENT
return
SCROLL'SCREEN:
XCALL OPNSCR, SCROLL'SCREEN ! Properly Open Scroll Screen.
SCROLL'UP'AR = SCROLL'WINDOW+1 ! Preset up arrow indicator.
SCROLL'DN'AR = SCROLL'WINDOW+2 ! Preset down arrow indicator.
! Set values in array and dim all input lines.
!
for X = 1 to SCROLL'WINDOW
XCALL SETVAL, SCROLL'SCREEN, X, SCROLL'ARRAY(X)
XCALL SETDFC, SCROLL'SCREEN, X, 11,12
next X
! Set title.
!
xcall SETVAL, SCROLL'SCREEN, SCROLL'WINDOW+3, SCROLL'TITLE$
! Process scrolling until MENU or EXECUTE.
!
SCROLL'EDIT:
XCALL GTSCR, SCROLL'SCREEN, SCROLL'CHAR, SCROLL'FIELD
X = (SCROLL'CHAR and 255)
IF (SCROLL'CHAR and 255) = ESP'MENU goto SCROLL'END
IF (SCROLL'CHAR and 255) = ESP'EXECUTE goto SCROLL'END
IF (SCROLL'CHAR and 255) = ESP'HOME call SCROLL'HOME : goto SCROLL'EDIT
IF (SCROLL'CHAR and 255) = ESP'END call SCROLL'EOS : goto SCROLL'EDIT
IF (SCROLL'CHAR and ESP'POSTEDIT) then call SCROLL'UPD
goto SCROLL'EDIT
SCROLL'END:
XCALL CLSSCR, SCROLL'SCREEN
return
! Scroll Update.
!
SCROLL'UPD:
IF (X < 10) OR (X > 11) : SCROLL'CHAR = ESP'BEGLIN : return
xcall SETDFC, SCROLL'SCREEN, SCROLL'FIELD, 11, 12
X = SCROLL'FIELD
IF (SCROLL'CHAR AND 255) = 10 call SCROLL'DOWN
IF (SCROLL'CHAR AND 255) = 11 call SCROLL'UP
xcall TOOLBZ, TBX'HIDFLD, SCROLL'SCREEN, SCROLL'UP'AR, FALSE
xcall TOOLBZ, TBX'HIDFLD, SCROLL'SCREEN, SCROLL'DN'AR, FALSE
if SCROLL'CURRENT =1 xcall TOOLBZ, TBX'HIDFLD, SCROLL'SCREEN, SCROLL'UP'AR, TRUE
if SCROLL'CURRENT = SCROLL'MAX xcall TOOLBZ, TBX'HIDFLD, SCROLL'SCREEN, SCROLL'DN'AR, TRUE
return
! Scroll Down.
!
SCROLL'DOWN:
if SCROLL'FIELD < SCROLL'WINDOW then X=X+1
xcall SETDFC, SCROLL'SCREEN, X, 0,0
SCROLL'CURRENT=SCROLL'CURRENT+1
if SCROLL'FIELD <> SCROLL'WINDOW goto SCROLL'DOWN'END
SCROLL'CHAR = ESP'BEGLIN
IF SCROLL'CURRENT > SCROLL'MAX then SCROLL'CURRENT= SCROLL'MAX : GOTO SCROLL'DOWN'END
for X = 1 to SCROLL'WINDOW
XCALL SETVAL, SCROLL'SCREEN, X, SCROLL'ARRAY(SCROLL'CURRENT-(SCROLL'WINDOW-X))
next X
SCROLL'DOWN'END:
return
! Scroll UP
!
SCROLL'UP:
if SCROLL'FIELD > 1 X=X-1
xcall SETDFC, SCROLL'SCREEN, X, 0,0
SCROLL'CURRENT=SCROLL'CURRENT-1
if SCROLL'FIELD <> 1 goto SCROLL'UP'END
SCROLL'CHAR = ESP'BEGLIN
IF SCROLL'CURRENT < 1 SCROLL'CURRENT=1 : GOTO SCROLL'UP'END
for X = 1 TO SCROLL'WINDOW
XCALL SETVAL, SCROLL'SCREEN, X, SCROLL'ARRAY(SCROLL'CURRENT+X-1)
next X
SCROLL'UP'END:
return
! User pressed HOME KEY.
!
SCROLL'HOME:
xcall SETDFC, SCROLL'SCREEN, SCROLL'FIELD, 11, 12
SCROLL'CURRENT = 1
for X = 1 to SCROLL'WINDOW
xcall SETVAL, SCROLL'SCREEN, X, SCROLL'ARRAY(X)
next X
SCROLL'FIELD = 1
SCROLL'CHAR = ESP'BEGLIN
SCROLL'CURRENT = 0
X = 0
xcall TOOLBZ, TBX'HIDFLD, SCROLL'SCREEN, SCROLL'UP'AR, TRUE
xcall TOOLBZ, TBX'HIDFLD, SCROLL'SCREEN, SCROLL'DN'AR, FALSE
goto SCROLL'DOWN
! User pressed END KEY or CTRL-E
!
SCROLL'EOS:
xcall SETDFC, SCROLL'SCREEN, SCROLL'FIELD, 11, 12
SCROLL'CURRENT = SCROLL'MAX-SCROLL'WINDOW
for X = 1 to SCROLL'WINDOW
xcall SETVAL, SCROLL'SCREEN, X, SCROLL'ARRAY(SCROLL'CURRENT+X)
next X
SCROLL'FIELD = SCROLL'WINDOW
SCROLL'CHAR = ESP'BEGLIN
SCROLL'CURRENT = SCROLL'MAX+1
X = SCROLL'WINDOW+1
xcall TOOLBZ, TBX'HIDFLD, SCROLL'SCREEN, SCROLL'UP'AR, FALSE
xcall TOOLBZ, TBX'HIDFLD, SCROLL'SCREEN, SCROLL'DN'AR, TRUE
goto SCROLL'UP
FETCH'ERROR:
xcall ERRDSP, "Fetch Error #"+STR(X)
end
ERR'ROUTINE:
xcall ERRDSP, "Basic Error #"+STR(ERR(0))
END