'Note: 
'   You may have trouble running this program from the editor. If so,
'change the Path$ variable in INITIALISE to point to the directory this
'example is in. This isn't a problem when compiled.

'********************************************************************
'* 
'*   Painter 
'* 
'********************************************************************

'   This is a very simple paint program, an extension of the scribble  
'example. It is, admittedly rather hampered by the lack of a fill command, 
'but what the hell...

'   Here we demonstrate a rather larger program than has been used before, 
'involving two windows (two WHOLE windows??!), a painting area and a palette.
'It shows the use of super windows, gimme zero zero windows, and the custom
'scroller routines provided in the Scroller.amos example. We open a super
'window with an actual area the size and depth of the workbench screen,
'and then scroll around this using J Scroll Super Window. Other stuff has
'all been seen before, such as basic gadgets, menus and drawing commands.
'There are alot of extra IDCMP messages used here, such as INTUITICKS for
'the spray can, and the WA_MouseQueue tag for the window.

'   Some changes have been made to the GadToolsBox source: 

'   The variable SD has been added to hold the default screen depth. The 
'palette gadget will be drawn with this number of planes. The art window 
'has been changed into a super window, the size and depth of the default 
'screen. The J Close Window line in _FREE_WINDOW has been changed to 
'J Close Super Window. This is safe to call on non-super windows.
'   Other minor changes have been made for stuff I forget to add in the
'GadToolsBox program (bad planning). 

'   The scroller routines added are explained in the Scroller.amos program,
'the advantage being that they automatically resize and move when the window 
'changes. They are handled as follows: 
'   The size of each scroller is the size of the drawing area the window 
'contains. The visible area (the size of the widget on the scroller) is the
'actual size of the window.
'   We then track the offset of the drawing area from the top left of the
'window using the variables _SBX,_SBY. Sliding the bottom scroller distance
'x to the right will put the top left of the drawing area distance -x from the top 
'top left of the window, and _SBX is set to the value x. 
'   When the window is resized, we must change the size of the widget in the 
'scroller to reflect the new area we are representing. We may also need to 
'move the drawing area. This will occur when the user is looking at the bottom 
'right of the drawing area, then enlarges the window. The drawing area must
'be moved right and down to prevent the window showing a region off the edge 
'of the drawing area.

'   A technique of use to other art program writers shown here is rubber 
'banding. An interesting feature of Gr Writing 2 is that if you draw a shape,
'then draw exactly over it again, the image is restored exactly as it was. 
'This allows us to rubber band shapes like lines or bars so the user can 
'experiment with where the shape should go before placing it. The shape is 
'then drawn with Gr Writing 0. 

Global _SCRAPTAGS,SCRAPTAGS,_PORTLIST,_MESSLIST
Global PATH$,OSVER
'** SD was put here with the rest of the prefs 
Global FHEIGHT,FWIDTH,MBAR,OX,OY,SW,SH,SD
Dim _ARTGADS(0)
Global _ARTGADS()
Global _ARTMENU,_ARTMENADD
Global _ARTWIND
Dim _PALETTEGADS(1)
Global _PALETTEGADS()
Global _PALETTE
Dim _PALETTEZOOM(1)
Global _PALETTEZOOM()
Global _PALETTEWIND

On Error Proc _CLEANUP

'** _SCRLLERS is used to represent the border scroller gadgets.
'   _SBX, _SBY are the offset of the top left of the window from the top 
'   left of the drawing area.
Global _SCRLLERS
Global _SBX,_SBY

'** _DRAW is 1 when the LMB is pressed, 0 when it isn't. 
'   _TYPE is the drawing mode 0-6, in the same order the tools are on the
'   tools menu. Defaults to free hand (1)
'   _OX, _OY hold the origin of a drawing operation (a line, or whatever)
'   _LX, _LY hold the position we last drew to so we can draw over it again
'   for rubber banding purposes. 
Global _DRAW,_TYPE,_OX,_OY,_LX,_LY
_TYPE=1

_INITIALIZE
_GUIDATA
_SETUPALL
_SETPORTS

'Make sure we draw to the right window 
J This Window _ARTWIND
Do 
   K=J Wait Message
   While K
      C=J Tag Data(_MESSLIST,1)

      If C=Equ("IDCMP_CLOSEWINDOW")
         'Bring up a requester before quiting 
         If J Easy Request(_ARTWIND,"Quit"," Are you ure you"+Chr$(10)+"want to quit?"," Quit | Cancel ",0)
            _CLEANUP
         End If 

      Else If C=Equ("IDCMP_REFRESHWINDOW")
         _DOREFRESH

      Else If J Tag Data(_MESSLIST,9)=_ARTWIND
         'There is a lot of handling, so I've stuck it in another procedure.
         _HANDLE_ARTWIND[C]

      Else If J Tag Data(_MESSLIST,9)=_PALETTEWIND
         'The only interesting event from the palette window is the user  
         'picking a colour, so watch for this 
         If C=Equ("IDCMP_GADGETUP")
            J This Window _ARTWIND
            J Ink J Tag Data(_MESSLIST,2)
         End If 

      End If 
      K=J Next Message
   Wend 
Loop 

'This is the biggy...
Procedure _HANDLE_ARTWIND[C]
   On Error Proc _CLEANUP

   If C=Equ("IDCMP_IDCMPUPDATE")
      'First off, deal with the scrollers being moved. We get the position 
      'of each (just to make sure we didn't miss anything), as X and Y.
      'We then check they aren't both in the same place (don't move if you 
      'don't need to...) 
      'Finally, we move the scroll the window, and change _SBX and _SBY    
      _GETSCROLLERPOS[_SCRLLERS,True]
      X=Param
      _GETSCROLLERPOS[_SCRLLERS,False]
      Y=Param
      If X<>_SBX or Y<>_SBY
         J Scroll Super Window _ARTWIND,X-_SBX,Y-_SBY
         _SBX=X : _SBY=Y
      End If 

   Else If C=Equ("IDCMP_NEWSIZE")
      'Here we deal with the user resizing the window. 
      'First get the window's new size (inner size, that is) 
      IW=J Window Width-J X Offset-J Border Right-1
      IH=J Window Height-J Y Offset-J Border Bottom-1

      'Now we check if further scrolling is required to keep only the
      'drawing area visible. I'm not even going to attempt explaining the
      'twisted logic in these formulas - I can't remember, and I only wrote
      'them half an hour ago...
      DX=0 : DY=0
      If IW>-_SBX+SW
         DX=IW+_SBX-SW
      End If 
      If IH>-_SBY+SH
         DY=IH+_SBY-SH
      End If 
      J Scroll Super Window _ARTWIND,-DX,-DY
      _SBX=_SBX-DX : _SBY=_SBY-DY

      'Finally, we adjust the size of the widget in the scrollers
      J Tag SCRAPTAGS,1,Equ("PGA_Visible"),IW
      J Tag 0,0
      _SETSCROLLERDATA[_ARTWIND,_SCRLLERS,True,SCRAPTAGS]
      J Tag SCRAPTAGS,1,Equ("PGA_Visible"),IH
      _SETSCROLLERDATA[_ARTWIND,_SCRLLERS,False,SCRAPTAGS]

   Else If C=Equ("IDCMP_MOUSEBUTTONS")

      If J Tag Data(_MESSLIST,2)=Equ("SELECTDOWN")
         'If the user pressed the LMB:
         'Put us in drawing mode, and make the origin (_OX,_OY) this position 
         'We also move the graphics cursor to here and set the last position
         'to here. Various of these are necessary for various drawing 
         'operations. 
         'We also change the drawing mode if this operation requires rubber 
         'banding.
         _DRAW=1
         _OX=J Tag Data(_MESSLIST,5)-J X Offset+_SBX
         _OY=J Tag Data(_MESSLIST,6)-J Y Offset+_SBY
         _LX=_OX : _LY=_OY
         Gr Locate _OX,_OY
         If _TYPE>1 and _TYPE<6
            Gr Writing 2
         Else 
            Gr Writing 0
         End If 

      Else If J Tag Data(_MESSLIST,2)=Equ("SELECTUP")
         'If the user released the LMB: 
         'Take us out of drawing mode.
         'Fill in the shape. If there was rubber banding, we actually draw
         'it twice, but this is a very minor bug. 
         _DRAW=0
         _LX=J Tag Data(_MESSLIST,5)-J X Offset+_SBX
         _LY=J Tag Data(_MESSLIST,6)-J Y Offset+_SBY
         Gr Writing 0
         _DRAW[_LX,_LY]
      End If 

   Else If C=Equ("IDCMP_MOUSEMOVE") and _DRAW
      'If the user has moved the mouse in drawing mode, we do the drawing
      'operation.
      _DRAW[J Tag Data(_MESSLIST,5)-J X Offset+_SBX,J Tag Data(_MESSLIST,6)-J Y Offset+_SBY]

   Else If C=Equ("IDCMP_INTUITICKS") and _DRAW and _TYPE=6
      'INTUITICKS sends about 5-10 messages a second, which we need for
      'the spray can so the user can hold it in one place and spray. 
      _DRAW[J Tag Data(_MESSLIST,5)-J X Offset+_SBX,J Tag Data(_MESSLIST,6)-J Y Offset+_SBY]

   Else If C=Equ("IDCMP_MENUPICK")
      'Finally, the menus. Read them off in the normal way...
      C=J Tag Data(_MESSLIST,2)
      M=J Read Menu(C)
      I=J Read Item(C)

      If M=0
         If I=0
            'If New Project was selected, request then do it.
            If J Easy Request(_ARTWIND,"Clear Screen","Sure you want to"+Chr$(10)+"clear the screen?"+Chr$(10)+"No undo is possible!"," Clear | Cancel ",0)
               J This Window _ARTWIND
               J Cls 0
            End If 
         Else If I=2
            'Quit, as usual, calls up a requester before doing it. 
            If J Easy Request(_ARTWIND,"Quit"," Are you ure you"+Chr$(10)+"want to quit?"," Quit | Cancel ",0)
               _CLEANUP
            End If 
         End If 

      Else If M=1
         'Change the type of tool we're using at the moment.
         _TYPE=I
      End If 

   End If 
   
End Proc
'another biggy...
Procedure _DRAW[X,Y]
   On Error Proc _CLEANUP
   
   'X,Y are the current mouse coordinates.

   If _TYPE=0
      'Dots: just put a point under the mouse
      Plot X,Y

   Else If _TYPE=1
      'Free hand: Draw a line from where we last were to where we are now. 
      Draw To X,Y

   Else If _TYPE=2
      'Lines: First, draw to the last position. Because we're rubber banding,
      'this will erase the last line. Then draw a new line.
      Draw _OX,_OY To _LX,_LY
      Draw _OX,_OY To X,Y
      _LX=X : _LY=Y

   Else If _TYPE=3
      'Boxes: Just like Lines. 
      Box _OX,_OY To _LX,_LY
      Box _OX,_OY To X,Y
      _LX=X : _LY=Y

   Else If _TYPE=4
      'Ellipses: First, calculate x and y radii for the ellipse, then if 
      'these are both greater than 1, draw the ellipse. This is done twice 
      'for rubber banding. 
      RX=Abs(_OX-_LX) : RY=Abs(_OY-_LY)
      If RX=>1 and RY=>1
         Ellipse _OX,_OY,RX,RY
      End If 
      RX=Abs(_OX-X) : RY=Abs(_OY-Y)
      If RX=>1 and RY=>1
         Ellipse _OX,_OY,RX,RY
      End If 
      _LX=X : _LY=Y

   Else If _TYPE=5
      'Bars: Should be like boxes, but AMOS's bar command is over-sensitive. 
      'If the coordinates are the wrong way round, we must swap them, other
      'wise an error is generated. This requiers two temporary variables.
      'Also, the box must be at least 1x1 in size, so check that.
      TX=_OX : TY=_OY
      If TX>_LX : Swap TX,_LX : End If 
      If TY>_LY : Swap TY,_LY : End If 
      If _LX>TX and _LY>TY
         Bar TX,TY To _LX,_LY
      End If 
      _LX=X : _LY=Y
      TX=_OX : TY=_OY
      If TX>X : Swap TX,X : End If 
      If TY>Y : Swap TY,Y : End If 
      If X>TX and Y>TY
         Bar TX,TY To X,Y
      End If 

   Else If _TYPE=6
      'Spray Can: This splatters pointers in a circle, radius 10. First
      'we take a random point within 10 pixels of the cursor, then check 
      'this is within a circle radius 10 (otherwise, we get a square). 
      'The formula is x^2 + y^2 <= radius^2, which defines a circle
      For I=0 To 4
         DX=Rnd(20)-10 : DY=Rnd(20)-10
         If DX^2+DY^2<=100
            Plot X+DX,Y+DY
         End If 
      Next I
   End If 

End Proc

Procedure _INITIALIZE
'** Added the SD=J Screen Depth line 
Procedure _SETUPALL
Procedure _GUIDATA
Procedure _MAKEARTGADS
'** Changed to a super window, and added scrollers 
Procedure _MAKEARTWIND[SC]
'** changed so depth of palette gadget = SD
Procedure _MAKEPALETTEGADS
Procedure _MAKEPALETTEWIND[SC]
Procedure _DOREFRESH
Procedure _SETPORTS
'** chaged J Close Window to J Close Super Window
Procedure _FREEWIND[W,G,M,A,C]
'** added line to free scrollers 
Procedure _CLEANUP

'************************************************************************

'   scrollers = _CREATESCROLLERS[ window, right total, right visible,
'      botom total, bottom visible]

'   When you get an IDCMP message from one of the scrollers, it will be of 
'class IDCMP_IDCMPUPDATE, and the code field will contain 0 if it is the 
'right slider or 1 if it's the bottom one. You can then get the slider height
'using _GETSCROLLERPOS.  

Procedure _CREATESCROLLERS[W,RT,RV,BT,BV]

'************************************************************************

'   _FREESCROLLERS[ scrollers ]

Procedure _FREESCROLLERS[G]
   On Error Goto E
   
   'quit if there is no gadget list 
   If G=False Then Goto E
   
   'get the address of the map from the first gadget and free it. 
   T=Leek(G+Equ("gg_UserData"))
   If T Then T=J Free Mem(T,12)
   
   'get the address of the bottom gadget
   N=Leek(G+Equ("gg_NextGadget"))
   'free the right gadget 
   Areg(0)=G
   V=Intcall(Lvo("DisposeObject"))
   'free the bottom gadget (if it was successfully created).
   If N
      Areg(0)=N
      V=Intcall(Lvo("DisposeObject"))
   End If 
   
   E:
End Proc

'************************************************************************

'   position = _GETSCROLLERPOS[ scrollers, which? ]

Procedure _GETSCROLLERPOS[G,X]
   If G=0 Then Goto E
   
   'the attribute we want 
   Dreg(0)=Equ("PGA_Top")
   'the gadget we want
   If X
      G=Leek(G)
   End If 
   Areg(0)=G
   'the result is stored here 
   R=0
   Areg(1)=Varptr(R)
   'call the function 
   V=Intcall(Lvo("GetAttr"))
   
   E:
End Proc[R]

'************************************************************************

'   _SETSCROLLERDATA[ window, scrollers, which?, taglist ] 

'   Very similar to J Set Gadget Data, this command allows you to change 
'the total area, visible area and slider position of a scroller. The tags
'to use are PGA_Total, PGA_Visible and PGA_Top, and provide a taglist just 
'as for J Set Gadget Data. 

Procedure _SETSCROLLERDATA[W,G,X,T]

'************************************************************************

'   _ADDSCROLLERS[ window, scrollers ] 

Procedure _ADDSCROLLERS[W,G]
   On Error Goto E
   
   If G=0 or W=0 Then Goto E
   
   Areg(0)=W
   Areg(1)=G
   Dreg(0)=-1
   Dreg(1)=-1
   Areg(2)=False
   V=Intcall(Lvo("AddGList"))
   Areg(0)=G
   Areg(1)=W
   Areg(2)=False
   Dreg(0)=-1
   V=Intcall(Lvo("RefreshGList"))
   
   E:
End Proc