REM >Director:Menus.Scroll

ON ERROR: ON ERROR OFF: ERROR ERR,REPORT$+" at "+STR$ ERL
debug%=FALSE
IF debug% THEN *ReportTrace ON

buffer_size%=1023
DIM buffer% buffer_size%
SYS "OS_GetEnv" TO comm%
SYS "OS_ReadArgs","name,quit,do/k,win,icon/k,pos,posdir",comm%,buffer%,1023
IF buffer%!8<>0 do$=FNlcase(FNstring(buffer%!8)) ELSE do$=""
IF buffer%!12<>0 THEN
  win$=FNlcase(FNstring(buffer%!12))
ELSE
  win$=FNread("Director$Window")
ENDIF
IF win$<>"" win%=EVAL(win$)
IF buffer%!16<>0 THEN
  icon$=FNlcase(FNstring(buffer%!16))
ELSE
  icon$=FNread("Director$Icon")
ENDIF
IF icon$<>"" icon%=EVAL(icon$) ELSE icon%=0
IF buffer%!20<>0 pos%=EVAL(FNstring(buffer%!20)) ELSE pos%=0
IF buffer%!24<>0 posdir$=FNlcase(FNstring(buffer%!24))

IF icon%=-6 OR icon%=-7 OR icon%=-8 vert%=TRUE ELSE vert%=FALSE
IF icon%=-6 OR icon%=-8 OR icon%=-10 OR icon%=-14 arrow%=TRUE ELSE arrow%=FALSE

DIM state% 64:!state%=win%
DIM info% 88:!info%=win%
SYS "Wimp_GetWindowInfo",,info%+1
vis_xmin%=info%!4
vis_xmax%=info%!12
vis_ymin%=info%!8
vis_ymax%=info%!16
xscroll%=info%!20
yscroll%=info%!24
wrk_xmin%=info%!44
wrk_xmax%=info%!52
wrk_ymin%=info%!48
wrk_ymax%=info%!56
IF (info%!32 AND 1<<8)<>0 OR (info%!32 AND 1<<9)<>0 scroll%=TRUE ELSE scroll%=FALSE

IF debug% SYS "Report_Text0","Window handle: "+STR$~(win%)
IF debug% SYS "Report_Text0","Visible x (min): "+STR$(info%!4)
IF debug% SYS "Report_Text0","Visible x (max): "+STR$(info%!12)
IF debug% SYS "Report_Text0","Visible y (min): "+STR$(info%!8)
IF debug% SYS "Report_Text0","Visible y (max): "+STR$(info%!16)
IF debug% SYS "Report_Text0","X scroll offset: "+STR$(info%!20)
IF debug% SYS "Report_Text0","Y scroll offset: "+STR$(info%!24)
IF debug% SYS "Report_Text0","Work x (min)   : "+STR$(info%!44)
IF debug% SYS "Report_Text0","Work x (max)   : "+STR$(info%!52)
IF debug% SYS "Report_Text0","Work y (min)   : "+STR$(info%!48)
IF debug% SYS "Report_Text0","Work y (max)   : "+STR$(info%!56)
IF debug% SYS "Report_Text0"," "

SYS "Wimp_Initialise",310,&4B534154,"Temp" TO ,handle%

IF do$="" THEN
  PROCmenu
ELSE
  CASE do$ OF
    WHEN "here":   PROChere
    WHEN "top":    info%!24=wrk_ymax%
                   SYS "Wimp_OpenWindow",,info%
    WHEN "bottom": info%!24=vis_ymax%-vis_ymin%+wrk_ymax%+wrk_ymin%
                   SYS "Wimp_OpenWindow",,info%
    WHEN "left":   info%!20=wrk_xmin%
                   SYS "Wimp_OpenWindow",,info%
    WHEN "right":  info%!20=vis_xmax%-vis_xmin%+wrk_xmax%+wrk_xmin%
                   SYS "Wimp_OpenWindow",,info%
    OTHERWISE:
      IF scroll% THEN
        CASE do$ OF
          WHEN "scrollup":    info%!32=0:info%!36=1
          WHEN "scrolldown":  info%!32=0:info%!36=-1
          WHEN "pageup":      info%!32=0:info%!36=2
          WHEN "pagedown":    info%!32=0:info%!36=-2
          WHEN "scrollleft":  info%!32=-1:info%!36=0
          WHEN "scrollright": info%!32=1:info%!36=0
          WHEN "pageleft":    info%!32=-2:info%!36=0
          WHEN "pageright":   info%!32=2:info%!36=0
          OTHERWISE:          ERROR 0, "Unrecognized parameter supplied."
        ENDCASE
        SYS "Wimp_SendMessage",10,info%,win%
      ELSE
        CASE do$ OF
          WHEN "scrollup":    info%!24=yscroll%-32
          WHEN "scrolldown":  info%!24=yscroll%+32
          WHEN "pageup":      info%!24=vis_ymax%-vis_ymin%+yscroll%
          WHEN "pagedown":    info%!24=vis_ymin%-vis_ymax%+yscroll%
          WHEN "scrollleft":  info%!20=xscroll%-32
          WHEN "scrollright": info%!20=xscroll%+32
          WHEN "pageleft":    info%!20=vis_xmax%-vis_xmin%+xscroll%
          WHEN "pageright":   info%!20=vis_xmin%-vis_xmax%+xscroll%
          OTHERWISE:          ERROR 0, "Unrecognized parameter supplied."
        ENDCASE
        SYS "Wimp_OpenWindow",,info%
      ENDIF
  ENDCASE
ENDIF
SYS "Wimp_CloseDown"
END

DEF PROChere
REM VDU4:PRINT pos%, posdir$
ENDPROC

:

DEF PROCmenu
Dash%=FNswi_number("Director_Dash")
Option%=FNswi_number("Director_Option")
Command%=FNswi_number("Director_Command")
Command$="/Director:Menus.System.Scroll -win "+STR$(win%)+" -do "

DIM ptr% 20
SYS "Wimp_GetPointerInfo",,ptr%
IF debug% SYS "Report_Text0","Mouse x: "+STR$(!ptr%)
IF debug% SYS "Report_Text0","Mouse y: "+STR$(ptr%!4)

REM height%=vis_ymin%-visymax%-20-20

IF vert% THEN
  IF yscroll%=wrk_ymax% go_up%=FALSE ELSE go_up%=TRUE
  IF vis_ymin%-vis_ymax%+yscroll%=wrk_ymin% go_down%=FALSE ELSE go_down%=TRUE
  IF debug% SYS "Report_Text0","Go up   : "+STR$(go_up%)
  IF debug% SYS "Report_Text0","Go down : "+STR$(go_down%)
ELSE
  IF xscroll%=wrk_xmin% go_left%=FALSE ELSE go_left%=TRUE
  IF vis_xmax%-vis_xmin%+xscroll%=wrk_xmax% go_right%=FALSE ELSE go_right%=TRUE
  IF debug% SYS "Report_Text0","Go left : "+STR$(go_left%)
  IF debug% SYS "Report_Text0","Go right: "+STR$(go_right%)
ENDIF

SYS "Director_Menu","Scroll ScrollMenu -temp"
SYS Option%, "Windows -sub ""Dynamic:/Director:Menus.System.Switch -do Sub"""
SYS Option%, """This window"" -sub ""Dynamic:/Director:Menus.System.Close "+STR$(win%)+""""
IF vert% THEN
  IF go_up% OR go_down% SYS Dash%
  IF NOT arrow% AND (go_up% OR go_down%) THEN
    x%=!ptr%:
    SYS Option%, """Scroll here"""
      SYS Command%, Command$+"here "+STR$(pos%)+" vert"
    SYS Dash%
  ENDIF
  IF go_up% SYS Option%, "Top"
    IF go_up% SYS Command%, Command$+"top"
  IF go_down% SYS Option%, "Bottom"
    IF go_down% SYS Command%, Command$+"bottom"
  IF go_up% OR go_down% SYS Dash%
  IF go_up% SYS Option%, """Scroll up"""
    IF go_up% SYS Command%, Command$+"scrollup"
  IF go_down% SYS Option%, """Scroll down"""
    IF go_down% SYS Command%, Command$+"scrolldown"
  IF go_up% OR go_down% SYS Dash%
  IF go_up% SYS Option%, """Page up"""
    IF go_up% SYS Command%, Command$+"pageup"
  IF go_down% SYS Option%, """Page down"""
    IF go_down% SYS Command%, Command$+"pagedown"
ELSE
  IF go_left% OR go_right% SYS Dash%
  IF NOT arrow% AND (go_left% AND go_right%) THEN
    SYS Option%, """Scroll here"""
      SYS Command%, Command$+"here "+STR$(pos%)+" horiz"
    SYS Dash%
  ENDIF
  IF go_left% SYS Option%, """Left edge"""
    IF go_left% SYS Command%, Command$+"left"
  IF go_right% SYS Option%, """Right edge"""
    IF go_right% SYS Command%, Command$+"right"
  IF go_left% OR go_right% SYS Dash%
  IF go_left% SYS Option%, """Scroll left"""
    IF go_left% SYS Command%, Command$+"scrollleft"
  IF go_right% SYS Option%, """Scroll right"""
    IF go_right% SYS Command%, Command$+"scrollright"
  IF go_left% OR go_right% SYS Dash%
  IF go_left% SYS Option%, """Page left"""
    IF go_left% SYS Command%, Command$+"pageleft"
  IF go_right% SYS Option%, """Page right"""
    IF go_right% SYS Command%, Command$+"pageright"
ENDIF
SYS "Director_EndMenu"
*DirectorShowMenu ScrollMenu
ENDPROC

DEF FNread(a$)
  ?buffer%=13
  SYS "XOS_ReadVarVal",a$,buffer%,buffer_size%,0,3 TO ,,read%
  buffer%?read%=13
=$buffer%

DEF FNswi_number(name$)
  SYS "OS_SWINumberFromString",,name$ TO A%
=A%

DEF FN0(a%)
s$=""
WHILE ?a%>=32
 s$+=CHR$?a%
 a%+=1
ENDWHILE
=s$

DEF FNlcase(text$)
LOCAL Loop%,text2$
text2$=""
FOR Loop%=1 TO LEN(text$)
  chr%=ASC(MID$(text$,Loop%,1))
  IF chr%>64 AND chr%<91 chr%=chr%+32
  text2$+=CHR$(chr%)
NEXT
=text2$

DEF FNstring(ptr%):LOCAL a$:a$=""
WHILE ?ptr%>31
  a$+=CHR$(?ptr%):ptr%+=1
ENDWHILE:=a$
