
' This sample uses the OLD CD API

#include once "crt.bi"
#include once "inc/iup.bi"
#include once "inc/iupcd.bi"

sub _init_ constructor
  IupOpen(0,0)
end sub

sub _exit_ destructor
  IupClose()
end sub

dim shared As ubyte image(640,400)

function redraw_cb cdecl (self as Ihandle Ptr ,sx as single, sy as single) as integer
  dim as integer x, y
  sx = IupGetFloat(self, "POSX")
  sy = -IupGetFloat(self, "POSY")
  If cdActiveCanvas() Then cdClear()

  for x=0 To x=319
    for y=0 To y=199
      if (image((320.0*sx)+x,(200.0*sy)+y)) then cdMark(x,y)
    next
  next
  return IUP_DEFAULT
end function

function button_cb cdecl(self as Ihandle ptr ,botao as integer , iestado as integer, x as integer, y as integer) as integer 
  dim as single sx = IupGetFloat(self, "POSX")
  dim as single sy =-IupGetFloat(self, "POSY")
  cdUpdateYAxis(@y)
  if (botao = IUP_BUTTON1 and iestado) then
    cdMark(x,y)
    image((320.0*sx)+x,(200.0*sy)+y) = 1
  end if
  return IUP_DEFAULT
end function

function  motion_cb cdecl (self as Ihandle ptr, x as integer, y as integer) as integer
  static as zstring*40 buffer
  dim as single sx = IupGetFloat(self, "POSX")
  dim as single sy =-IupGetFloat(self, "POSY")
  x = x + 320*sx : y = y + 200*sy
  sprintf(buffer,"(%d, %d)",x,y)
  IupStoreAttribute(IupGetHandle("label"),"TITLE", buffer)
  return IUP_DEFAULT
end function

function scroll_cb cdecl (self as Ihandle ptr) as integer
  redraw_cb(self,0.0,0.0)
  return IUP_DEFAULT
end function

function enter_cb cdecl (self as Ihandle ptr) as Integer
  cdBackground(CD_WHITE) : redraw_cb(self,0.0,0.0)
  return IUP_DEFAULT
end function

function leave_cb cdecl (self as Ihandle ptr) as integer
  cdBackground(CD_GRAY) : redraw_cb(self,0.0,0.0)
  IupSetAttribute(IupGetHandle("label"),"TITLE","canvas")
  return IUP_DEFAULT
end function

'
' main
'
dim as Ihandle ptr dlg, canvas, label
dim as cdCanvas ptr cdcanvas
dim as integer x,y
for x=0 To x=639
  for y=0 To y=399
    image(x,y)=0
  next
next


label = IupLabel("canvas                ")

IupSetHandle("label", label)

canvas = IupCanvas(NULL)

IupSetAttributes(canvas, "CURSOR=CROSS, RASTERSIZE=320x200, EXPAND=NO, SCROLLBAR=YES, DX=0.5, DY=0.5")
IupSetCallback(canvas, "ACTION"        , cast (Icallback,@redraw_cb))
IupSetCallback(canvas, "BUTTON_CB"     , cast (Icallback,@button_cb))
IupSetCallback(canvas, "SCROLL_CB"     , cast (Icallback,@scroll_cb))
IupSetCallback(canvas, "MOTION_CB"     , cast (Icallback,@motion_cb))
IupSetCallback(canvas, "ENTERWINDOW_CB", cast (Icallback,@enter_cb))
IupSetCallback(canvas, "LEAVEWINDOW_CB", cast (Icallback,@leave_cb))

dlg = IupDialog(IupVbox(canvas,IupHBox(IupFill(), label, IupFill(), NULL), NULL))
IupSetAttributes(dlg, "TITLE=canvas,RESIZE=NO,MAXBOX=NO")
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)

cdcanvas = cdCreateCanvas(cdContextIup(), canvas)
if (cdcanvas = 0) then
  IupMessage("canvas","Error creating canvas")
  IupDestroy(dlg)
  end
end If
cdActivate(cdcanvas)
cdClear()

IupMainLoop()

