superstrict
framework brl.retro
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

 äithink its some sort of the same problem as before
'check tframe if window in window
superstrict
framework sj.all2
import brl.graphics
import brl.glgraphics
import brl.max2d
import brl.glmax2d
import brl.d3d7max2d
'import brl.freetypefont
'import brl.bmploader
'import brl.tgaloader
'import brl.jpgloader 'noneed
'import brl.pngloader 'noneed
'import brl.freeaudioaudio
'import brl.wavloader
'import brl.oggloader
'include "units2\sys.bmx"
'include "units2\gadget.bmx"

global win:twin=createwin("New",0,0,800,600,15+window_hidden)
win.center
win.reset

global can:tcan=createcan(0,0,win.cw,win.ch,win.g)

win.kid=can.g
win.show
win.activate

sethotkeyevent key_x  ,modifier_alt,createevent(event_windowclose,win.g)
sethotkeyevent key_esc,0           ,createevent(event_windowclose,win.g)

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

global framepos%[4]
global framearea%[4]

type tframe
  field pos%[4]
  field prv:tframe

  method get()
    intmov framearea,pos,4
    intmov framepos,pos,4
    local s:tframe=prv
    while s
      framepos[0]:+s.pos[0]
      framepos[1]:+s.pos[1]
      framearea[0]:+s.pos[0]
      framearea[1]:+s.pos[1]
      if (framearea[0]<s.pos[0]) then
        framearea[2]:-s.pos[0]-framearea[0]
        framearea[0]=s.pos[0]
      endif
      if (framearea[1]<s.pos[1]) then
        framearea[3]:-s.pos[1]-framearea[1]
        framearea[1]=s.pos[1]
      endif
      if (framearea[0]+framearea[2]>s.pos[0]+s.pos[2]) then framearea[2]:-(framearea[0]+framearea[2])-(s.pos[0]+s.pos[2])
      if (framearea[1]+framearea[3]>s.pos[1]+s.pos[3]) then framearea[3]:-(framearea[1]+framearea[3])-(s.pos[1]+s.pos[3])
      s=s.prv
    wend
  endmethod
endtype

function freekern(krn:tkern var)
  krn.closeall
  krn=null
endfunction

type tdkern
  field tag%
  field data:object[]
  field on:object(krn:tkern)
  field off:object(krn:tkern)
  field done:object(krn:tkern)
  field call:object(krn:tkern)[]
endtype

const kern_break%=$1 'at checkall,updateall
type tkern
  field data:tdkern[]
  field now%
  field opt%

  method open(init2:object(krn:tkern)=null,done2:object(krn:tkern)=null,on2:object(krn:tkern)=null,off2:object(krn:tkern)=null)
    if data.length and data[now].off then data[now].off self
    now=data.length
    data=data[..now+1]
    data[now]=new tdkern
    data[now].on=on2
    data[now].off=off2
    data[now].done=done2
    if init2 then init2 self
    if on2 then on2 self
  endmethod

  method close(nr%)
    if not data.length then return
    local n%=now
    if (nr=n) and data[n].off then data[n].off self
    now=nr
    if data[nr].done then data[nr].done self
    for local a%=nr until data.length-1
      data[a]=data[a+1]
    next
    data=data[..data.length-1]
    if (nr=n) and data[nr].on then data[nr].on self
  endmethod

  method closeall()
    if not data.length then return
    if data[now].off then data[now].off self
    for now=0 until data.length
      data[now].done self
    next
    data=data[..0]
  endmethod

  method add(call2:object(krn:tkern))
    data[now].call=data[now].call[..data[now].call.length+1]
    data[now].call[data[now].call.length-1]=call2
  endmethod

  method find%(callnr%,prc:object(krn:tkern))
    for local a%=0 until data.length
      if (data[a].call[callnr]=prc) then return a
    next
    return -1
  endmethod

  method move(pos1%,pos2%)
    if not data.length then return
    local dir%=1
    if (pos1>pos2) then
      dir=pos1
      pos1=pos2
      pos2=dir
      dir=-1
    endif

    if (now>=pos1) and (now<pos2) then
      if data[now].off then data[now].off self
      now:+dir
      if data[now].on then data[now].on self
    endif

    pos2:-1
    while (pos1<=pos2)
      local e:tdkern=data[pos1]
      data[pos1]=data[pos1+1]
      data[pos1+1]=e
      pos1:+dir
    wend
  endmethod

  method upd(nw%,call%)
    now=nw
    if (call<data[nw].call.length) and data[nw].call[call] then data[nw].call[call] self
  endmethod

  method updall(dir%,call%)
    if not data.length then return
    opt:&~kern_break
    local nw%=now
    now=0
    if (dir<0) then now=data.length-1
    repeat
      if (call<data[now].call.length) and data[now].call[call] then data[now].call[call] self
      now:+dir
    until (now=data.length) or (now=-1) or (opt&kern_break)
    now=nw
  endmethod
endtype

const win_side%=$1+$2+$4+$8
const win_move%=$10
const win_size%=$20
type tkwin
  field frame:tframe=new tframe
  field opt%

  method upd(krn:tkern,e:tev)
    if (e.down=0) then
      opt:&~(win_side+win_move+win_size)
      return
    endif
    if (opt&(win_move+win_size)) then
      krn.opt:|kern_break
      return
    endif
    opt:&~(win_side+win_move+win_size)
    if not e.first then return
    if not e.area(framepos[0],framepos[1],framepos[2],framepos[3]) then return
    krn.opt:|kern_break
    krn.move krn.now,krn.data.length-1
  endmethod

  method move(krn:tkern,e:tev)
    if (opt&win_move=0) then
      if e.first=1 then
        if not e.area(framepos[0]+10,framepos[1]+10,framepos[2]-20,framepos[3]-20) then
          opt:|win_move
          frame.pos[0]:+e.mx
          frame.pos[1]:+e.my
        endif
      endif
    else
      frame.pos[0]:+e.mx
      frame.pos[1]:+e.my
    endif
  endmethod
endtype

function drawkwin()
if kern.now then
  setcolor 128,0,0
else
  setcolor 0,128,0
endif
  drawrect framepos[0],framepos[1],framepos[2],framepos[3]
  setcolor 255,255,255
  drawbox framepos[0],framepos[1],framepos[2],framepos[3]
  drawbox framepos[0]+10,framepos[1]+10,framepos[2]-20,framepos[3]-20
endfunction

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

global ev:tev=new tev
global kern:tkern=new tkern

function clock_init:object(krn:tkern)
  krn.data[krn.now].data=krn.data[krn.now].data[..1]
  krn.data[krn.now].data[0]=new tkwin
endfunction
function clock_upd:object(krn:tkern)
  tkwin(krn.data[krn.now].data[0]).frame.get
  tkwin(krn.data[krn.now].data[0]).upd krn,ev
  if (kern.opt&kern_break=0) then return null
  tkwin(krn.data[krn.now].data[0]).move krn,ev
'  tkwin(krn.data[krn.now].data[0]).size krn,ev
endfunction
function clock_draw:object(krn:tkern)
  tkwin(krn.data[krn.now].data[0]).frame.get
  setviewport framearea[0],framearea[1],framearea[2],framearea[3]
'  setorigin framearea[0],framearea[1]
  drawkwin
drawtext "just a simple test here",framepos[0],framepos[1]
drawtext framepos[0]+":"+framearea[0],framepos[0],framepos[1]+10
endfunction

kern.open clock_init
tkwin(kern.data[kern.now].data[0]).frame.pos[2]=100
tkwin(kern.data[kern.now].data[0]).frame.pos[3]=100
kern.add clock_upd
kern.add clock_draw

kern.open clock_init
'tkwin(kern.data[kern.now].data[0]).frame.prv=tkwin(kern.data[0].data[0]).frame
tkwin(kern.data[kern.now].data[0]).frame.pos[0]=20
tkwin(kern.data[kern.now].data[0]).frame.pos[1]=20
tkwin(kern.data[kern.now].data[0]).frame.pos[2]=100
tkwin(kern.data[kern.now].data[0]).frame.pos[3]=100
kern.data[kern.now].tag=1
kern.add clock_upd
kern.add clock_draw

repeat
  waitgadgetsystem
'printevent

  select win.upd()
  case event_windowclose  exit
  endselect

  ev.upd
if ev.key=key_space then
  kern.move 0,1
endif
  kern.updall -1,0

  select can.upd()
  default
    setviewport 0,0,can.w,can.h
    cls
    kern.updall 1,1
    flip
  endselect
forever