*
* Graphics Example Program
*
* The program below creates and displays a single-playfield display
* that is 320 pixels wide, 200 pixels lines high, and two bit-planes
* deep.
*
* converted from C example on page 2-28 of "ROM Kernal Manual" Volume 1
*

      program graphics

      implicit none                     ! keeps us out of trouble

      include graph.inc

      integer*4 DEPTH  ; parameter (DEPTH=2)
      integer*4 WIDTH  ; parameter (WIDTH=320)
      integer*4 HEIGHT ; parameter (HEIGHT=200)

      integer*4 cm                      ! pointer to ColorMap

      integer*4 amiga,loc               ! define the interface functions
      integer*4 i,j,k,n

      integer*2 colortable(0:3)         ! my own colors
      integer*2 boxoffsets(3)           ! where to draw boxes

      integer*4 displaymem
      integer*4 colorpalette

      integer*4 oldview                 ! save pointer to old view so that
                                        ! we can restore it

      integer*4 RASSIZE,w,h             ! for the RASSIZE statement function


      data colortable /z'0000',z'0f00',z'00f0',z'000f'/
*                       black   red     green   blue

      data boxoffsets /802,2010,3218/


* (defined as a macro in C)

      RASSIZE(w,h) = h * (shift(w+15,-3) .and. z'fffe')


      i = amiga(GfxBase)                ! get pointer to "graphics.library"
      oldview = long(i+gb_ActiView)     ! save current view pointer

      call amiga(InitView,View)         ! initialize View
      call amiga(InitVPort,ViewPort)    ! initialize ViewPort
      v_ViewPort = loc(ViewPort)        ! link View into ViewPort

* init BitMap (for RasInfo and RastPort)

      call amiga(InitBitMap,BitMap,DEPTH,WIDTH,HEIGHT)

* init RasInfo

      ri_BitMap   = loc(BitMap)
      ri_RxOffset = 0
      ri_RyOffset = 0
      ri_Next     = 0

* now specify critical characteristics

      vp_DWidth  = WIDTH
      vp_DHeight = HEIGHT
      vp_RasInfo = loc(RasInfo)

* init color table
* four entries since only two planes deep

      cm = amiga(GetColorMap,4)
      colorpalette = long(cm+cm_ColorTable)
        do (i=0,3)
          word(colorpalette+i*2) = colortable(i)
        repeat

* copy my colors into this data structure

      vp_ColorMap = cm

* allocate space for bit map

        do (i=1,DEPTH)
          bm_Planes(i) = amiga(AllocRaster,WIDTH,HEIGHT)
          if (bm_Planes(i) = 0) stop "Not Enough Memory"
        repeat

* contruct copper instr (prelim) list
* merge prelim lists together into a real
* copper list in the view structure

      call amiga(MakeVPort,View,ViewPort)
      call amiga(MrgCop,View)

* zeros to all bytes of the display area

        do (i=1,2)
          displaymem = bm_Planes(i)
            do (j=0,RASSIZE(WIDTH,HEIGHT)-1)
              byte(displaymem+j) = 0
            repeat
        repeat

      call amiga(LoadView,loc(View))

* now fill some boxes so that the user can see something
* always draw into both planes to assure true colors

        do (n=1,3)
          do (k=0,1)
            displaymem = bm_Planes(k+1) + boxoffsets(n)
            call drawfilledbox(displaymem,n,k,bm_BytesPerRow)
          repeat
        repeat

      do (100000 times); repeat         ! do nothing for a while

      call amiga(LoadView,oldview)      ! put back the old view

* return user and system-allocated memory to sys manager

        do (i=1,DEPTH)
          call amiga(FreeRaster,bm_Planes(i),WIDTH,HEIGHT)
        repeat

      call amiga(FreeColorMap,cm)
      call amiga(FreeVPortCopLists,ViewPort)
      call amiga(FreeCprList,v_LOFCprList)

      end


      subroutine drawfilledbox(mem,fillcolor,plane,BytesPerRow)

      implicit none

      integer*4 mem,fillcolor,plane
      integer*2 BytesPerRow
      integer*4 i,j
      integer*1 value

        do (j=0,99)
            if ((fillcolor .and. shift(1,plane)) <> 0) then
               value = z'ff'
            else
               value = 0
            end if
            do (i=0,19)
              byte(mem+i) = value
            repeat
          mem = mem+BytesPerRow-20
        repeat

      end