  '19/07/2019
  '22/02/2026
  '27/04/2026
  'CP

  % on  1
  % off 0

  'DEFAULT SETTINGS
  %% fontA     "Arial",FW_NORMAL,1 // FW_SEMIBOLD
  %% fontB     "Courier New",FW_NORMAL,1
  %% ExplicitMain
 '%% WindowStyle WS_POPUP
  %% WindowStyle WS_OVERLAPPEDWINDOW
  '
  '%% Shaders
  '
  '
'  macro keydown()
'  ===============
'  'case 32 'no action
'  #ifdef NoEscape
'    case 27 'take no action (otherwise close window)
'  #endif
'  end macro
  '
  uses OpenglSceneFrame
  uses glo2\shapes
  uses glo2\materials

  indexbase 1

  'GLOBALS
  '=======
  sys       typeface
  int       cutn
  string    cut[1000]
  string    inputs,lastinput, previnput
 

  macro SelectWithKeys(r,b,e)
  ===========================
  r=0
  select lastkey
    case 13 : r=picked  'enter
    case 32 : picked+=1 'space
    case 38 : picked-=1 'up
    case 40 : picked+=1 'down
    case 36 : picked=1  'home
    case 35 : picked=10 'end
  end select
  if picked<b then picked=e
  if picked>e then picked=b
  end macro


  ! main() as sys
  def print output



  sub Initialize(sys hWnd)
  ========================
  GDIplus 1
  'SetTimer hWnd,1,10,null
  % ms 20
  CreateTimerQueueTimer timer,0,@timetick, 0 ,0, ms, 0 'ms milliseconds
  gwnd=hwnd
  '
  cube = CompileList
    CubeForm 
  glEndList
  '
  sphere = CompileList
    Spheric 1,1,6
  glEndList
  '
  cylinder = CompileList
    glRotatef 180,1,0,0
    Conefaces  32,0,0,1 'BASE CAP 
    glRotatef 180,1,0,0
    Conefaces  32,1,1,1 'SIDE
    glTranslatef 0,1,0 
    Conefaces  32,0,0,1 'TOP CAP 
    glTranslatef 0,-1,0 
  glEndList
  '
  GenTextures 32
  '
  #ifdef midisound
    '-1 midimapper (will accept MidiOutLongMsg)
    ' 0 default synth
    ermo=midiOutOpen(hmo, -1, 0, 0, CALLBACK_NULL)
  #endif
  '
  end sub

  sub Release(sys hwnd)
  =====================
  DeleteAllGlCompiled
  DeleteTextures 32
  GDIplus 0
  'killTimer hwnd, 1
  DeleteTimerQueueTimer 0,timer,0
  #ifdef midisound
  MidiOutClose(hmo)
  #endif
  end sub

  sub title(string s)
  ===================
  SetWindowText gWnd,s
  end sub

  sub grid(optional float r, int a,b,s,p)
  =======================================
  int i
  if not s then s=1
  if not r then r=s
  if not a then a=s
  if not b then b=s
  glBegin GL_LINES
  'vertical lines
  for i=0 to a step s 
    glVertex2f r*i,.0
    glVertex2f r*i,r*b
  next
  'horizontal lines
  for i=0 to b step s 
    glVertex2f .0 ,r*i
    glVertex2f r*a,r*i
  next
  glEnd
  if p then
    glColor4f 0,0,0,0 'overlay to make grid pickable
    glBegin GL_QUADS
    glVertex2f 0,0 : glVertex2f r*a,0
    glVertex2f r*a,r*b : glVertex2f 0,r*b
    glEnd
    glColor4fv fcolor
  end if
  end sub


  sub arc(optional float r,a,b,s)
  ===============================
  float ar,br,c
  if not r then r=1.0
  if a=0. and b=0. then b=360 'DEFAULT WHOLE CIRCLE
  if not s then s=5.0 'DEFAULT STEP
  s=abs(s)
  while a>b : b+=360.0 : wend
  glBegin GL_LINE_STRIP
  do
    ar=rad(a)
    br=rad(b)
    glVertex2f r*cos(ar),r*sin(ar)
    a+=s
    if a>=b
      glVertex2f r*cos(br),r*sin(br)
      exit do
    end if
  end do
  glEnd
  end sub

  sub fan(optional float r,a,b,s)
  ===============================
  float ar,br,c
  if not r then exit sub
  if a=0.0 and b=0.0 then b=360.0 'DEFAULT WHOLE CIRCLE
  if not s then s=5.0
  if not s then s=5.0 'DEFAULT STEP
  s=abs(s)
  glBegin GL_TRIANGLE_FAN
  glVertex2f 0.0, 0.0
  do
    ar=rad(a)
    br=rad(b)
    glVertex2f r*cos(ar),r*sin(ar)
    a+=s
    if a>=b
      glVertex2f r*cos(br),r*sin(br)
      exit do
    end if
  end do
  glEnd
  end sub

  sub cls(float r=0.0, g=0.0, b=0.0, a=1.0)
  =========================================
  flat
  bcolor={r,g,b,a}
  glClearColor r, g, b, a
  end sub


  procedure output(string s="", float lf=0, int pf=0)
  ===================================================
  'ENABLE MOUSE PICKING
  pickchars=pf
  if lf
    glPushMatrix
  end if
  gprint s,0,typeface
  if lf
    glPopMatrix
    glTranslatef .0,-lf,.0
  end if
  pickchars=0
  end procedure

  sub printl(string s="",int pf=0)
  ================================
  output s,1.0, pf
  end sub


  int cp 'char position
  int cn ' next cell
  int le 'length of sting

  function ShowInput(string s) 
  ============================
  int c
  int i,le,en,pt
  float x,y
  glPushMatrix
  le=len s
  en=le+1
  i=1
  pt=picktext 'save
  do
    if i>en then exit do
    if i>le then
      c=32
    else
      c=asc(s,i)
      if c<32 then c=32
    end if
    if pick=0
      colortype f at @fcolor
      if i=cp
        glColor4f f.r*.5, f.g*.5, f.b*.5, 1.0
        GetCharArea c,x,y,typeface
        PutBoxArea x,y,-.0001
        glColor4f .99,.99,.99, 1.0
      else
        glColor4f f.r, f.g, f.b, 1.0
      end if
    end if
    gprint chr(c),0,typeface
    i++
    picktext++
  end do
  picktext=pt 'restore
  glPopMatrix
  glTranslatef .0,-1.0,.0 'linefeed
  end function 'ShowInput

  
  function input(bstring *s, int mo=0, pf=0) as int
  =================================================
  'mo=0 'insert
  'mo=1 'overtype
  PickChars=pf
  int pk=picked
  cn=0
  le=len s
  if cp=0 or le=0
    cp=1
  endif
  if lastchar
    if key(VK_CONTROL)
      exit function
    endif
    select lastchar
    case 8 'backspace-delete
      cp-=1
      if cp<1 then
        cp=1
        function=lastchar
      else
        s=left(s,cp-1)+mid(s,cp+1)
      end if
    case 9 'tab
      '
    case 26,27 'ctrl-z, escape
      function=lastchar
    case 13 'enter
      lastinput=s
      if s then previnput=s
      function=lastchar
    case else
      s=left(s,cp-1)+chr(lastchar)+mid(s,cp+mo)
      cp+=1
    end select
  elseif lastkey
    'cursor placement etc
    select lastkey
    case 37 : cp-=1     'left
    case 39 : cp+=1     'right
    case 36 : cp=1      'home
    case 35 : cp=le+1   'end
    case 38 :           'up
    case 40 :           'down
    case 46 : 'delete
      if cp<=le
        s=left(s,cp-1)+mid(s,cp+1)
      else
        function=46
      end if
    end select
    if cp<1 then cp=1 : cn=-1
    if cp>le+1 then cp=le+1 : cn=1
  end if
  ShowInput s 'show chars being entered
  '
  PickChars=0
  end function 'input
  '
  '  

  sub scene(sys hWnd)
  ===================
  %ColorCodedPick
  BeginPick
  #ifdef Animated
    ActiveFrame
  #else
    LazyFrame
  #endif
  if not pick
    StandardLighting li
    StandardMaterial ma
    color .00,.80,.80,.99
  else
    PickSetup
  endif
  glDisable GL_TEXTURE_2D
  '
  #ifdef PlaceCentral
    gltranslatef  .0,.0,-2.414 'viewport bottom=-1.0 top=1.0
  #else
    #ifdef AnchorCentral
      gltranslatef  -.95,.90,-2.414 'locks to centre
    #else 'AnchorLeft
      gltranslatef  -.95*aspect,.90,-2.414 'locks to left margin
    #endif
  #endif
  float f=.0625 '1/16
  #ifndef ScaleUp
    'LIMIT SCALING WITH WINDOW HEIGHT > 640
    if crect.bottom>640 then f*=640/crect.bottom
  #endif
  glscalef f,f,f
  main()
  EndPick
  bWheel=0
  end sub

  def BeginScript
  nop
  end def

  def EndScript
  MainWindow width,height, WindowStyle,2
  end def

