superstrict
framework brl.retro
'import "_resicon.o"
import brl.timer
import brl.graphics
import brl.glgraphics
import brl.max2d
import brl.glmax2d
import brl.d3d7max2d
import brl.maxgui
import brl.win32maxgui

'import brl.freetypefont
'import brl.bmploader
'import brl.tgaloader
'import brl.jpgloader 'noneed
'import brl.pngloader 'noneed
'import brl.wavloader
'import brl.oggloader
'import pub.freeprocess
'import pub.stdc
'import blitz3d.blitz3dsdk
'include "units2\sys.bmx"
'include "units2\gadget.bmx"

apptitle="New"

global win:tgadget=createwindow("New",100,100,500,500,,15-window_menu-window_status+window_hidden)
global can:tgadget=createcanvas(0,0,500,500,win)
setgraphics canvasgraphics(can)

sethotkeyevent key_x  ,modifier_alt,createevent(event_windowclose,win)
sethotkeyevent key_escape,0           ,createevent(event_windowclose,win)

'------------------------------------------

global secmil%=millisecs(),oldmil%
addhook fliphook,hookflip
function hookflip:object(id%,data:object,context:object)
  local a%=millisecs()
  oldmil=a-secmil
  secmil=a
endfunction

function drawbox(x%,y%,w%,h%)
  w:+x-1
  h:+y-1
  drawline x,y,w,y,false
  drawline w,y,w,h,false
  drawline w,h,x,h,false
  drawline x,h,x,y,false
endfunction

function drawcbox(x%,y%,w%,h%,rgbl%,rgbr%)
  w:+x-1
  h:+y-1
  setcolor rgbr shr 16,rgbr shr 8&$ff,rgbr&$ff
  drawline w,y,w,h,false
  drawline w,h,x,h,false
  setcolor rgbl shr 16,rgbl shr 8&$ff,rgbl&$ff
  drawline x,y,w,y,false
  drawline x,h,x,y,false
endfunction

'------------------------------------------

type tev
  field x%,y%
  field mx%,my%,mz%
  field down%,up%,first%,last%

  method area%(x1%,y1%,w1%,h1%)
    return (x>=x1) and (y>=y1) and (x<=x1+w1) and (y<=y1+h1)
  endmethod

  method upd()
    mx=0
    my=0
    mz=0
    up=0
    first=0
    last=0
    select currentevent.id
    case event_mousemove
      mx=x
      my=y
      x=currentevent.x
      y=currentevent.y
      mx=x-mx
      my=y-my
    case event_mousewheel
      mz=currentevent.data

    case event_mousedown
      local a%=1 shl (currentevent.data-1)
      if not down then first=a
      down:|a
    case event_mouseup
      local a%=1 shl (currentevent.data-1)
      down:&~a
      if not down then last=a
      up=a
    endselect
  endmethod
endtype

'-----------------------------------------

type tframe
  field x%,y%,w%,h%
  field prev:tframe
  field lvl%
  field opt% '$1=mouse over,$2=hold,$80=on/off state

  global gx%,gy%,gw%,gh%
  global vx%,vy%,vw%,vh%
  global active:tframe
  global ox%,oy%

  method draw() abstract
'  method upd%(ev:tev) abstract

  method reset(xx%,yy%,ww%,hh%,p:tframe=null)
    x=xx
    y=yy
    w=ww
    h=hh
    prev=p
    lvl=0
    while p
      lvl:+1
      p=p.prev
    wend
  endmethod
  method posglobal(xx%,yy%)
    x=xx
    y=yy
    local p:tframe=prev
    while p
      x:-p.x
      y:-p.y
      p=p.prev
    wend
  endmethod

  method get%()
    gx=x
    gy=y
    gw=w
    gh=h
    vx=x
    vy=y
    vw=w
    vh=h
    local p:tframe=prev
    while p
      gx:+p.x
      gy:+p.y
      if (vx<0) then
        vw:+vx
        vx=0
      endif
      if (vy<0) then
        vh:+vy
        vy=0
      endif
      if (vx+vw>p.w) then vw=p.w-vx
      if (vy+vh>p.h) then vh=p.h-vy
      vx:+p.x
      vy:+p.y
      p=p.prev
    wend
    return (vw>0) and (vh>0)
  endmethod

  method upd%(ev:tev)
    if active and (active<>self) then return false
    if not get() then
      if ev.last then
        opt:&~$3
        active=null
      endif
      return false
    endif

    if ev.area(vx,vy,vw,vh) then
      opt:|$1
      if ev.first then
        active=self
        opt:|$2
        ox=gx-ev.x
        oy=gy-ev.y
      endif
      if (ev.last&$1) and (active=self) then opt:~$80
    else
      opt:&~$1
    endif

    if ev.last then
      opt:&~$2
      active=null
    endif
    return true
  endmethod
endtype

type tframe_empty extends tframe
  method upd%(ev:tev)
'    return super.upd(ev)
super.upd(ev)
if opt&$2 then posglobal ev.x+ox,ev.y+oy
'get
'if (vw<0) then x=-w+1
'if (vh<0) then y=-h+1
  endmethod

  method draw()
    if not get() then return
    setviewport vx,vy,vw,vh
if opt&$2 then setcolor 255,255,255 else setcolor 0,255,0
'setalpha 0.5
'drawrect gx,gy,gw,gh
'setalpha 1
    drawbox gx,gy,gw,gh
setviewport 0,0,canw,canh
drawtext bin(opt),gx,gy
  endmethod
endtype

type tframe_but extends tframe
  field txt$,tx%,ty%

  method set(t$)
    txt=t
    tx=(w-textwidth(txt))/2
    ty=(h-textheight(txt))/2
  endmethod

  method upd%(ev:tev)
    return super.upd(ev)
  endmethod

  method draw()
    if not get() then return
    setviewport vx,vy,vw,vh
    if (opt&$1) then setcolor 0,96,96 else setcolor 0,0,128
    if (opt&$2) then setcolor 0,128,128' else setcolor 128,0,0
    drawrect gx+1,gy+1,gw-1,gh-1
'    if (opt&$1) then setcolor 255,255,255 else setcolor 128,128,128
if (opt&$80) then drawcbox gx,gy,gw,gh,$00008888,$0000ffff else drawcbox gx,gy,gw,gh,$0000ffff,$00008888
    setcolor 255,255,255
    drawtext txt,gx+tx,gy+ty
  endmethod
endtype

type tframe_win extends tframe
  field border%=12

  method upd%(ev:tev)
    super.upd(ev)
    if (opt&$2) then
      if (ev.down&$1) then posglobal ev.x+ox,ev.y+oy
'      if (ev.down&$2) then w=(ev.x-gx)'+(ev.x+ox-gx)
      if (ev.down&$2) then
        w:+ev.mx
        h:+ev.my
      endif
    endif
  endmethod

  method draw()
    if not get() then return
    setviewport vx,vy,vw,vh
    setcolor 0,0,0
    drawrect gx+1,gy+1,gw-2,gh-2
    setcolor 255,255,255
    drawbox gx,gy,gw,gh
    drawline gx+1,gy+border,gx+gw-1,gy+border,false
    drawline gx+gw-border,gy+1,gx+gw-border,gy+gh-1,false
    drawline gx+gw-1,gy+gh-border,gx,gy+gh-border,false
    drawline gx+border,gy+gh-1,gx+border,gy,false
  endmethod
endtype

function sorttframe(f:tframe[])
  if not f[0].active or (f[0].active=f[0]) then return
  local a%=f.length
  while a
    a:-1
    if (f[a]=f[0].active) then exit
  wend
local l%=a
  for local b%=a until f.length'-1
'if f[b].prev=f[0].active.prev then
if f[b].lvl<=f[l].lvl then
    local x:tframe=f[b]
    f[b]=f[l]
    f[l]=x
l=b
endif
  next
endfunction

'-----------------------------------------

'global ev:tev_old=new tev_old
global ev:tev=new tev
global canw%=clientwidth(can)
global canh%=clientheight(can)

global tf:tframe[6]
tf[0]=new tframe_empty
tf[0].reset 50,50,canw-100,canh-100
tf[0].upd ev
tf[1]=new tframe_empty
tf[1].reset 50,30,canw-170,canh-170,tf[0]
tf[2]=new tframe_but
tf[2].reset 20,0,90,20,tf[1]
tframe_but(tf[2]).set "Hello"
tf[3]=new tframe_but
tf[3].reset 20,30,90,20,tf[1]
tframe_but(tf[3]).set "aha"
tf[4]=new tframe_win
tf[4].reset 60,5,130,80,tf[1]
tf[5]=new tframe_but
tf[5].reset 10,4,50,40,tf[4]
tframe_but(tf[5]).set "win"

showgadget win

setclscolor 64,64,64
global timer:ttimer=createtimer(25)
repeat
  waitevent
'printevent

  select currentevent.id
  case event_windowclose  exit
  case event_gadgetpaint,event_timertick
    cls
for local a%=0 until tf.length
'for local a%=tf.length-1 to 0 step-1
tf[a].draw
next
setviewport 0,0,canw,canh
'    ev.draw
    flip

  default
    ev.upd
for local a%=tf.length-1 to 0 step-1
'for local a%=0 until tf.length
tf[a].upd ev
next
sorttframe tf
  endselect
forever