/*
    bgrbitmap.c original code by Thomas Rapp
    bgrbitmap.e by ghh 2022

*/
OPT PREPROCESS


MODULE 'utility/tagitem','dos/dos','exec/memory'
MODULE 'intuition/intuition','intuition/screens'
MODULE 'graphics', 'graphics/rastport','graphics/gfx'
MODULE 'cybergraphics','cybergraphx/cybergraphics'

PROC main()
  DEF win:PTR TO window
  DEF bm:PTR TO bitmap
  DEF w,h
  DEF mess:PTR TO intuimessage
  DEF weiter
  DEF bmlock->:PTR TO CHAR  /*APTR*/
  DEF bpr
  DEF dataptr->:PTR TO BYTE
  DEF yptr->:PTR TO BYTE
  DEF xptr->:PTR TO BYTE
  DEF x,y
  DEF r,g,b

  IF (cybergfxbase:=OpenLibrary('cybergraphics.library',51))=NIL
    WriteF('Can not open cybergraphics.library')
    RETURN RETURN_FAIL
  ENDIF

  win:= OpenWindowTagList(NIL,
       [WA_Left,100,
        WA_Top,100,
        WA_Width,300,
        WA_Height,200,
        WA_Title,'Test mit einer BGR-Bitmap',
        WA_Flags,WFLG_CLOSEGADGET OR
          WFLG_DRAGBAR OR
          WFLG_DEPTHGADGET OR
          WFLG_ACTIVATE OR
          WFLG_NOCAREREFRESH,
        WA_IDCMP,IDCMP_CLOSEWINDOW OR
          IDCMP_VANILLAKEY,
        TAG_END])

  IF (win = NIL)
    CloseLibrary(cybergfxbase)
    WriteF('Kann das Fenster nicht öffnen !\n')
    RETURN RETURN_FAIL
  ENDIF

  IF (GetBitMapAttr(win.wscreen.rastport.bitmap,BMA_DEPTH)<=8)
    CloseWindow(win)
    CloseLibrary(cybergfxbase)
    WriteF('Dieses Programm läuft nur auf einem High- oder Truecolor-Bildschirmmodus !\n')
    RETURN RETURN_ERROR
  ENDIF

  w:= win.gzzwidth
  h:= win.gzzheight

  bm:= AllocBitMap(w,h,24,BMF_MINPLANES OR BMF_SPECIALFMT OR SHIFT_PIXFMT(PIXFMT_BGR24),NIL)

  IF (bm = NIL)
    CloseWindow(win)
    CloseLibrary(cybergfxbase)
    WriteF('Nicht genug Speicher für die Bitmap !\n')
    RETURN RETURN_FAIL
  ENDIF


  bmlock:= LockBitMapTagList(bm,
          [LBMI_BASEADDRESS,{dataptr},
           LBMI_BYTESPERROW,{bpr},
           TAG_END])

  IF (bmlock = NIL)
    FreeBitMap(bm)
    CloseWindow(win)
    CloseLibrary(cybergfxbase)
    WriteF('Kann Bitmap nicht sperren !\n')
    RETURN RETURN_FAIL
  ENDIF

  yptr:= dataptr

  y:=0
  WHILE (y < h)
    xptr:= yptr

    x:=0
    WHILE (x < w)
      r:= (x * 255) / (w-1)
      g:= (y * 255) / (h-1)
      b:= (r + g) / 2
      xptr[0]:= b
      xptr[1]:= g
      xptr[2]:= r
      xptr+=3
      x++

    ENDWHILE

    yptr+=bpr
    y++

  ENDWHILE

  UnLockBitMap(bmlock)

  BltBitMapRastPort(bm,0,0,win.rport,win.borderleft,win.bordertop,w,h,$c0)

  FreeBitMap(bm)

  weiter:= TRUE

  REPEAT

    WaitPort(win.userport)
    WHILE (mess:= GetMsg(win.userport))

      SELECT (mess.class)

        CASE IDCMP_VANILLAKEY
          IF (mess.code = $1b) /* Esc */
            weiter:= FALSE
          ENDIF

        CASE IDCMP_CLOSEWINDOW
          weiter:= FALSE

      ENDSELECT

      ReplyMsg(mess)

    ENDWHILE

  UNTIL (weiter = FALSE)

  CloseWindow(win)
  IF cybergfxbase  THEN CloseLibrary(cybergfxbase)

  RETURN RETURN_OK
ENDPROC