home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISOFT.LZH / HISOFT_A.MSA / HGT / WINDOW.BAS < prev    next >
BASIC Source File  |  1993-09-21  |  11KB  |  363 lines

  1. ' 31.3.92    djn maximums taken to include possible part characters at end of window
  2.  
  3. FUNCTION MyInterSection( BYVAL x1,BYVAL y1,BYVAL w1,BYVAL h1,_ ' First Source AES Rect
  4.             BYVAL x2,BYVAL y2,BYVAL w2,BYVAL h2,_ ' Second Source AES Rect
  5.             outx,outy,outw,outh)    ' Intersection Rect
  6. intersection x1,y1,w1,h1,x2,y2,w2,h2,outx,outy,outw,outh
  7. IF outh>0 AND outw>0 THEN myintersection=-1 ELSE myintersection=0
  8. END FUNCTION 
  9.  
  10. ' The windows section of the Toolbox
  11. 'These are the arrays
  12. 'where the mapping between the window handles and ReDrawProcs are stored
  13. 'There are HowManyWindows valid entries in this table and there may
  14. '    NOT be any 'holes' in the structure
  15.  
  16.  
  17. CONST woTsimple=0, woTobject=1,woTtext=2,woTimage=3,woTform=4
  18.  
  19.  
  20. ' Open a window and clear it to white with the given name and
  21. '   re-draw sub-program and returns the corresponding WindowHandle
  22. '   - if there was an error the GEM return value is given
  23. '   The name must be null-terminated and the Redraw sub-program has the
  24. '   following parameters:
  25. '    WindowHandle,x,y,w,h (all CARDINAL) of the window to draw
  26. '    This should re-draw that part of that window. There is no need
  27. '    to clear it to white first
  28.  
  29. FUNCTION OpenAWindow(WindowName$,BYVAL WindComp,BYVAL procaddr&,BYVAL slidermaxaddr&,BYVAL closeproc&)
  30. STATIC WindowHandle
  31. STATIC x1,y1,x2,y2,id
  32. SHARED WindX,WindY,WindW,WindH,HowManyWindows,WindowsInitialised,max_windows
  33. SHARED woHandle(1),woRedraw&(1),woSliderMax&(1),woClose&(1)
  34. SHARED woType(1),woOffx(1),woOffy(1)
  35.     IF    WindowsInitialised=0 THEN CALL InitWindowSystem
  36.     IF HowManyWindows=max_windows THEN 
  37.         CALL NoMoreWindows
  38.         EXIT SUB
  39.     END IF
  40. 'Find an unused BASIC window id
  41.     id=0
  42.     DO WHILE VARPTR(#257+id)
  43.         INCR id
  44.     LOOP
  45. ' OK we can use BASIC window id - we will get a runtime error if
  46. ' this doesn't work.
  47.     graf_mouse 256,0
  48.     WINDOW OPEN id,WindowName$,WindX,WindY,WindW,WindH,WindComp
  49.     
  50.     INCR HowManyWindows
  51.     
  52.     WINDOW READ id,5,WindowHandle    'read the AES handle
  53.     woHandle(HowManyWindows)=WindowHandle
  54.     woRedraw&(HowManywindows)=procaddr&
  55.     woSliderMax&(HowManyWindows)=slidermaxaddr&
  56.     woClose&(HowManyWindows)=closeproc&
  57.     woType(HowManyWindows)=woTsimple
  58.     woOffX(HowManyWindows)=0
  59.     woOffy(HowManyWindows)=0
  60.     vsf_color 0            '  fill with white
  61. '  set the clipping rectangle and clear it
  62.     junk=wind_get(WindowHandle,WF_WORKXYWH,x1,y1,x2,y2)
  63.     x2=x1+x2-1
  64.     y2=y1+y2-1
  65.     vs_clip 1,x1,y1,x2,y2
  66.     vr_recfl x1,y1,x2,y2
  67.     graf_mouse 257,0
  68.     OpenAWindow=WindowHandle
  69. END FUNCTION
  70.  
  71. DECLARE FUNCTION UserClose(BYVAL WindowHandle)
  72. DECLARE FUNCTION FormClose
  73.  
  74. ' Close a window of the given handle
  75. ' Note a variable parameter - will be set to 0 on exit
  76. SUB CloseAWindow(WindowHandle)
  77. STATIC j,k,id
  78. SHARED HowManyWindows
  79. SHARED userclose_enabled,formWindowsInitialised
  80. SHARED woHandle(1),woRedraw&(1),woSliderMax&(1),woClose&(1)
  81. SHARED woType(1),woOffx(1),woOffy(1),commoni
  82.     commoni=WhichWindow(WindowHandle)
  83. '    Debug "Closing window"+STR$(WindowHandle)+"Number"+STR$(i)
  84.     IF commoni>0 THEN
  85.         IF FormWindowsInitialised THEN
  86.             IF FormClose=0 THEN EXIT SUB
  87.         END IF
  88.         IF userclose_enabled THEN
  89.             IF UserClose(WindowHandle)=0 THEN EXIT SUB
  90.         END IF
  91.         DECR HowManyWindows
  92.         CALLS woClose&(commoni)
  93.         FOR j=commoni TO HowManyWindows
  94.             woHandle(j)=woHandle(j+1)
  95.             woRedraw&(j)=woRedraw&(j+1)
  96.             woSliderMax&(j)=woSlidermax&(j+1)
  97.             woClose&(j)=woClose&(j+1)
  98.             woType(j)=woType(j+1)
  99.             woOffx(j)=woOffx(j+1)
  100.             woOffy(j)=woOffy(j+1)
  101.         NEXT j
  102.         WINDOW READ windowhandle,6,id
  103.         IF id>=0 THEN
  104.             WINDOW CLOSE id
  105.         END IF
  106.     END IF
  107.     WindowHandle=0
  108. END SUB
  109.  
  110. ' Redraw a slider 1 for Horizontal, 0 for Vertical
  111. SUB OneSlider(BYVAL Horizontal, BYVAL TotalSize,BYVAL curpos,BYVAL Size)
  112. STATIC    i,j,k,temp&
  113. SHARED commonHandle
  114. IF TotalSize>0 THEN
  115. 'debug "slider"+STR$(Totalsize)+STR$(curpos)+STR$(size)
  116.     IF TotalSize<Size THEN
  117.     ' Its all at the top    
  118.         curpos=1
  119.         Size=1000
  120.     ELSE
  121.         temp&=1000*CLNG(curpos)
  122.         curpos=temp&\(CLNG(TotalSize)-Size)+1
  123.         IF curpos>1000 THEN curpos=1000
  124.         temp&=1000*CLNG(Size)
  125.         Size=temp& \CLNG(TotalSize)+1
  126.         IF Size>1000 THEN Size=1000
  127.     END IF
  128.     i=WF_VSLSIZE-Horizontal
  129.     k=0
  130.     j=wind_set(CommonHandle,i,Size,k,k,k)
  131.     i=i-7
  132.     j=wind_set(CommonHandle,i,CurPos,k,k,k)
  133. END IF
  134. END SUB
  135.  
  136. FUNCTION GetOffset(BYVAL TotalHeight,BYVAL Value)
  137. IF TotalHeight<0 THEN
  138.     GetOffset=0
  139. ELSE
  140.     GetOffset=(CLNG(Value)*CLNG(TotalHeight)\1000)
  141. END IF
  142. END FUNCTION
  143.  
  144.  
  145. SUB WindowSlid(BYVAL Horizontal,BYVAL WindowHandle,BYVAL Value)
  146. SHARED commoni,commonmaxx,commonmaxy,commonhandle
  147. SHARED cellx,celly
  148. SHARED woSliderMax&(1),woOffX(1),woOffY(1)
  149. STATIC x,y,w,h
  150.     commoni=WhichWindow(WindowHandle)
  151.     IF commoni>0 THEN
  152.         commonhandle=WindowHandle
  153.         CALLS woSliderMax&(commoni)
  154.         junk=wind_get(CommonHandle,WF_WORKXYWH,x,y,w,h)
  155.         h=(h\celly)*celly    'usable characters
  156.         w=(w\cellx)*cellx
  157.  
  158.         IF Horizontal THEN
  159.             woOffX(commoni)=GetOffset(commonmaxx-w,Value)
  160.         ELSE
  161.             woOffY(commoni)=GetOffset(commonmaxy-h,Value)
  162.         END IF
  163.         FullRedraw WindowHandle
  164.     END IF
  165. END SUB
  166.  
  167.  
  168.  
  169. SUB WindowArrowed(BYVAL WindowHandle, BYVAL which)
  170. SHARED woOffX(1),woOffY(1),cellx,celly,woSliderMax&(1)
  171. SHARED commonhandle,commoni,commonmaxx,Commonmaxy
  172. STATIC x,y,w,h,NewX,NewY
  173.     commoni=WhichWindow(WindowHandle)
  174.     IF commoni>0 THEN
  175.         junk=wind_get(WindowHandle,WF_WORKXYWH,x,y,w,h)
  176.         h=(h\celly)*celly    'usable characters
  177.         w=(w\cellx)*cellx
  178.         NewX=woOffX(commoni): NewY=woOffY(commoni)
  179.         SELECT CASE which
  180.         CASE    0: NewY=NewY-h
  181.         CASE     1: NewY=NewY+h
  182.         CASE    2: NewY=NewY-celly
  183.         CASE    3: NewY=NewY+celly
  184.         CASE    4: NewX=NewX-w
  185.         CASE    5: NewX=NewX+w
  186.         CASE    6: NewX=NewX-cellx
  187.         CASE    7: NewX=NewX+cellx
  188.         END SELECT
  189. ' Now check not too big or too small
  190.         commonhandle=WindowHandle
  191.         CALLS woSliderMax&(commoni)
  192.         woOffX(commoni)=MAX(MIN(NewX,((commonmaxx-w-1)\cellx+1)*cellx),0)
  193.         woOffY(commoni)=MAX(MIN(NewY,((commonmaxy-h-1)\celly+1)*celly),0)
  194.                         
  195.         FullReDraw WindowHandle
  196.     END IF 
  197. END SUB
  198.  
  199.  
  200. ' changes the window whose AES handle is WindowHandle to WindowName$
  201. SUB RenameWindow(WindowHandle,WindowName$)
  202. STATIC BasicHandle
  203.     WINDOW READ WindowHandle,6,BasicHandle    'convert from AES handle
  204.     WINDOW NAME BasicHandle,WindowName$
  205. END SUB
  206.  
  207.     
  208. ' redraw a given window taking note of the GEM re-draw list
  209. SUB ReDraw(WindowHandle,BYVAL x,BYVAL y,BYVAL w,BYVAL h)
  210. STATIC x1,y1,w1,h1,xvdi,yvdi,i
  211. SHARED commonx,commony,commonw,commonh,commonhandle
  212. SHARED woReDraw&(1)
  213.     graf_mouse 256,0
  214.     junk=wind_get(WindowHandle,WF_FIRSTXYWH,x1,y1,w1,h1)
  215.     WHILE (w1<>0) AND (h1<>0)
  216.         IF MyInterSection(x,y,w,h,x1,y1,w1,h1,commonx,commony,commonw,commonh) THEN
  217.             vsf_color 0            ' white
  218. ' set the rectangle AND clear it
  219.             xvdi=commonx+commonw-1:yvdi=commony+commonh-1
  220.             vs_clip 1,commonx,commony,xvdi,yvdi
  221.             vr_recfl commonx,commony,xvdi,yvdi
  222.  
  223. ' Now CALL the window specific routine
  224.             i=WhichWindow(WindowHandle)
  225.             IF i>0 THEN
  226.                 commonhandle=windowhandle 
  227.                 CALLS woReDraw&(i)
  228.                 UpdateSliders
  229.             END IF
  230.         END IF
  231.         junk=wind_get(WindowHandle,WF_NEXTXYWH,x1,y1,w1,h1)
  232.     WEND
  233.     graf_mouse 257,0
  234. END SUB
  235.  
  236.  
  237. ' redraws the entire window if exposed
  238. SUB FullReDraw(BYVAL WindowHandle)
  239. STATIC x,y,w,h
  240.         junk=wind_get(WindowHandle,WF_WORKXYWH,x,y,w,h)
  241.         Redraw WindowHandle,x,y,w,h
  242. END SUB
  243.  
  244. ' called when the window is moved OR changes size
  245. SUB ChangeWindow(BYVAL WindowHandle,BYVAL x,BYVAL y,BYVAL w,BYVAL h)
  246. SHARED woType(1),woObjectTree&(1),woBaseX(1),woBaseY(1),woOffX(1),woOffy(1)
  247. STATIC i
  248.     junk=wind_set(WindowHandle,WF_CURRXYWH,x,y,w,h)
  249.     i=WhichWindow(WindowHandle)
  250.     IF i=0 THEN EXIT SUB
  251.     IF woType(i)<>woTform THEN EXIT SUB
  252.     SelectTreeAddr woObjectTree&(i)
  253.     Setob_x 0,woBaseX(i)-woOffX(i)+x
  254.     Setob_y 0,woBasey(i)-woOffY(i)+y
  255.  
  256. END SUB
  257.  
  258. SUB UpdateSliders
  259. SHARED CommonHandle,Commoni,commonmaxx,commonmaxy
  260. SHARED woSliderMax&(1),woOffX(1),woOffY(1),woType(1)
  261. STATIC x,y,w,h
  262. SHARED Mess(1)
  263.     CommonHandle=Mess(3)
  264.     commoni=WhichWindow(CommonHandle)
  265.     IF commoni=0 THEN EXIT SUB
  266.     junk=wind_get(CommonHandle,WF_WORKXYWH,x,y,w,h)
  267.     CALLS woSliderMax&(commoni)
  268.     IF woType(commoni)=woTform THEN EXIT SUB            'without this the program crashes on old TOS
  269.     OneSlider 1,commonmaxx,woOffX(commoni),w
  270.     OneSlider 0,commonmaxy,woOffY(commoni),h
  271. END SUB
  272.  
  273. DECLARE SUB do_cursor(BYVAL win_handle,BYVAL mode)
  274.  
  275. SUB TopAWindow(VAL WindowHandle)
  276. SHARED woType(1)
  277. STATIC i
  278. i=WhichWindow(WindowHandle)
  279. junk=wind_set(windowhandle,WF_TOP,0,0,0,0)
  280. IF woType(i)=woTform THEN do_cursor windowhandle,1
  281. END SUB
  282.  
  283. SUB UnTopAWindow(BYVAL WindowHandle)
  284. SHARED woType(1)
  285. STATIC i
  286. i=WhichWindow(WindowHandle)
  287. IF woType(i)=woTform THEN do_cursor WindowHandle,0
  288. END SUB
  289.  
  290. 'Deals with the common window update requirements:
  291. '   Note that only includes redraw, topped,sized, moved, fulled etc
  292. ' Is passed a meesage a la evnt_mesag/evnt_multi
  293.  
  294. SUB WindowMessage
  295. SHARED windx,windy,windh,windw,mess(1),myap_id
  296. STATIC x,y,w,h,mes_type,tmp,align
  297.     mes_type=mess(0)
  298.     SELECT CASE mes_type
  299.         CASE WM_REDRAW:
  300.             ReDraw Mess(3),Mess(4),Mess(5),Mess(6),Mess(7)
  301.         CASE WM_TOPPED:
  302.             topawindow mess(3)
  303.         CASE WM_UNTOPPED:
  304.             UntopAWindow mess(3)
  305.         CASE WM_SIZED:
  306.             Changewindow Mess(3),Mess(4),Mess(5),Mess(6),Mess(7) ' current size
  307.             UpdateSliders
  308.         CASE WM_MOVED:        
  309.             mess(4)=byte_align(mess(4))-1
  310.             ChangeWindow Mess(3),Mess(4),Mess(5),Mess(6),Mess(7) ' current size
  311.          CASE WM_FULLED:
  312.             junk=wind_get(Mess(3),WF_CURRXYWH,x,y,w,h) ' current size
  313.  
  314.             IF (windw<>w) OR (windh<>h) OR (windx<>x) OR (windy<>y) THEN
  315.                 '  make as large as possible
  316.                 ChangeWindow  Mess(3),windx,windy,windw,windh
  317.             ELSE
  318.                 '  return to  the old size
  319.                 junk=wind_get(Mess(3),WF_PREVXYWH,x,y,w,h)
  320.                 ChangeWindow Mess(3),x,y,w,h
  321.             END IF
  322.             UpdateSliders
  323.         CASE WM_VSLID:
  324.             WindowSlid 0,Mess(3),Mess(4)
  325.         CASE WM_HSLID:
  326.             WindowSlid 1,Mess(3),Mess(4)
  327.         CASE WM_ARROWED:
  328.             WindowArrowed Mess(3),Mess(4)
  329.     END SELECT
  330. END SUB
  331.  
  332. 'Initialise the window system
  333. SUB    InitWindowSystem
  334. SHARED cellx,celly,HowManyWindows,myap_id
  335. SHARED woHandle(1),woRedraw&(1),woOffx(1),woOffy(1),woClose&(1)
  336. SHARED woType(1),woTindex(1),woSliderMax&(1)
  337. SHARED WindowsInitialised,max_windows
  338. IF aes_version>=&h330 THEN max_windows=19 ELSE max_windows=7
  339. REDIM woHandle(max_windows)    ' the handle of this window
  340. REDIM    woRedraw&(max_windows)    ' the address of the re-draw proc
  341. REDIM woSliderMax&(max_windows) ' slider handling routines
  342. REDIM woClose&(max_windows)    ' window closed handler
  343. REDIM woType(max_windows)
  344.  
  345. REDIM    woOffx(max_windows),woOffy(max_windows) 'offset of top left 0,0 unless we have scrolled
  346.  
  347. REDIM woTindex(max_windows)    'maps window numbers to indices in the lines$() array
  348. ' Utility functions for the windows section
  349. ' Returns the index in the wo... tables of Windowhandle
  350.  
  351.  
  352.  
  353.     HowManyWindows=0
  354.     junk=graf_handle(cellx,celly,junk,junk)
  355.     myap_id=PEEKW(PEEKL(GB+4)+ap_id)
  356.     WindowsInitialised=-1
  357. END SUB
  358.  
  359. SUB NoMoreWindows
  360. STATIC a$
  361. a$="[3][There are no more|windows available.| |Please close a window.][ OK ]"
  362. junk=form_alert(1,a$)
  363. END SUB