*
* QUIX  Simple line drawing example of the Absoft interface to the Amiga
*       ROM routines. This verison uses an Intuition Window.
*

      program qwix

      implicit none                     ! keeps us out of trouble

      include exec.inc
      include graph.inc
      include intuit.inc

      integer*4 amiga,loc               ! define the interface functions
      integer*4 x1(8),y1(8),x2(8),y2(8) ! line end points
      integer*4 x1inc,y1inc,x2inc,y2inc ! line end point increments
      integer*4 color                   ! current color
      integer*4 delay                   ! main loop delay factor

      integer*4 i                       ! loop variable

      character*5 w_title               ! window title
      integer Window                    ! pointer to "Window" structure
      integer*4 WIDTH,HEIGHT            ! current window width and height

      integer*2 menu(15)                ! the menu
      character*6 menu_title            ! menu title
      integer*2 mi1(17),mi2(17)         ! menu items
      integer*4 it1(5),it2(5)           ! menu item IntuitionText
      character*7 mi1_title,mi2_title   ! menu item titles

      integer message                   ! IntuitionMessage
      integer class                     ! im_Class
      integer code                      ! im_Code

      data menu,mi1,mi2,it1,it2 /15*0,17*0,17*0,5*0,5*0/


* open "graphics.library" before using "intuition.library"

      call amiga(GfxBase)

* open the window

      w_title = "Quix"//char(0)

      nw_LeftEdge   = 20
      nw_TopEdge    = 20
      nw_Width      = 500
      nw_Height     = 170
      nw_DetailPen  = -1
      nw_BlockPen   = -1
      nw_Title      = loc(w_title)
      nw_Flags      = WINDOWCLOSE .or. SMART_REFRESH .or. ACTIVATE .or.
     +                WINDOWSIZING .or. WINDOWDRAG .or. WINDOWDEPTH
      nw_IDCMPFlags = CLOSEWINDOW .or. MENUPICK
      nw_Type       = WBENCHSCREEN
      nw_FirstGdgt  = 0
      nw_CheckMark  = 0
      nw_Screen     = 0
      nw_BitMap     = 0
      nw_MinWidth   = 100
      nw_MinHeight  = 25
      nw_MaxWidth   = 640
      nw_MaxHeight  = 200

      Window = amiga(OpenWindow,NewWindow)
      if (Window=0) stop "'OpenWindow' failed"

* - get the window width and height less the borders

      WIDTH  = word(Window+wd_Width)-3
      HEIGHT = word(Window+wd_Height)-3

* - build the menu strip. Maintaining separately declared Menu structures
*   is both tedious and unnecessary. All array elements not explicitly
*   defined here were defined in the above DATA statement

      menu_title = "speed"//char(0)
      menu(5) = 80
      menu(6) = 10
      menu(7) = MENUENABLED
      call setadd(menu(8),menu_title)
      call setadd(menu(10),mi1)

      mi1_title  = "faster"//char(0)    ! IntuiText
      it1(4) = loc(mi1_title)           ! link to next menu item
      call setadd(mi1,mi2)
      mi1(5)  = 50
      mi1(6)  = 10
      mi1(7)  = ITEMTEXT .or. ITEMENABLED .or. HIGHCOMP
      call setadd(mi1(10),it1)

      mi2_title  = "slower"//char(0)
      it2(4) = loc(mi2_title)
      mi2(4)  = 10
      mi2(5)  = 50
      mi2(6)  = 10
      mi2(7)  = ITEMTEXT .or. ITEMENABLED .or. HIGHCOMP
      call setadd(mi2(10),it2)

      call amiga(SetMenuStrip,Window,menu)

* let 'er rip

      color = 0                         ! reset pen color

      delay = 500                       ! reset delay factor

      x1inc =  3
      y1inc =  7
      x2inc = -9
      y2inc = -5

      x1(1) = WIDTH/2
      y1(1) = HEIGHT/2
      x2(1) = x1(1) + 10
      y2(1) = y1(1) + 20

        do (i=1,7)
          x1(i+1) = x1(i) + x1inc
          y1(i+1) = y1(i) + y1inc
          x2(i+1) = x2(i) + x2inc
          y2(i+1) = y2(i) + y2inc
        repeat

        do

* determine if any events are waiting

          message = amiga(GetMsg,long(Window+wd_UserPort))
            if (message<>0) then
              class   = long(message+im_Class)
              code    = word(message+im_Code)
              call amiga(ReplyMsg,message)
              if (class = CLOSEWINDOW) exit
                if (code <> z'ffff') then
                  i = amiga(ItemAddress,menu,code)
                    if (i=loc(mi1)) then
                      delay = max(0,delay-500)
                    else
                      delay = delay+500
                    end if
                end if
            end if

* update window width and height

          WIDTH  = word(Window+wd_Width)-3
          HEIGHT = word(Window+wd_Height)-3

* erase last line

          call amiga(SetAPen,long(Window+wd_RPort),0)
          call amiga(Move,long(Window+wd_RPort),x1(8),y1(8))
          call amiga(Draw,long(Window+wd_RPort),x2(8),y2(8))

* set new pen color

          color = color+1; if (color=32) color = 1
          call amiga(SetAPen,long(Window+wd_RPort),color)

* shift lines up

            do (i=7,1,-1)
              x1(i+1) = x1(i)
              y1(i+1) = y1(i)
              x2(i+1) = x2(i)
              y2(i+1) = y2(i)
            repeat

* increment the first line

          x1(1) = x1(1) + x1inc
            if (x1inc<0) then
              if (x1(1)<2) then
                x1(1) = 2
                x1inc = 0-x1inc
              end if
            else
              if (x1(1)>WIDTH) then
                x1(1) = WIDTH
                x1inc = 0-x1inc
              end if
            end if

          y1(1) = y1(1) + y1inc
            if (y1inc<0) then
              if (y1(1)<10) then
                y1(1) = 10
                y1inc = 0-y1inc
              end if
            else
              if (y1(1)>HEIGHT) then
                y1(1) = HEIGHT
                y1inc = 0-y1inc
              end if
            end if

          x2(1) = x2(1) + x2inc
            if (x2inc<0) then
              if (x2(1)<2) then
                x2(1) = 2
                x2inc = 0-x2inc
              end if
            else
              if (x2(1)>WIDTH) then
                x2(1) = WIDTH
                x2inc = 0-x2inc
              end if
            end if

          y2(1) = y2(1) + y2inc
            if (y2inc<0) then
              if (y2(1)<10) then
                y2(1) = 10
                y2inc = 0-y2inc
              end if
            else
              if (y2(1)>HEIGHT) then
                y2(1) = HEIGHT
                y2inc = 0-y2inc
              end if
            end if

          call amiga(Move,long(Window+wd_RPort),x1(1),y1(1))
          call amiga(Draw,long(Window+wd_RPort),x2(1),y2(1))

          do (delay times); repeat

        repeat

      call amiga(ClearMenuStrip,Window)
      call amiga(CloseWindow,Window)

      end


*
* - routine for stashing the address of an argument in a variable,
*   particularly handy when the variable is actually an array whose
*   elements are other than four bytes long
*

      subroutine setaddr(arg1,arg2)
      integer arg1,arg2,loc
      arg1 = loc(arg2)
      end