Paste: sine-gadget with ortho* combinator

USING: accessors arrays combinators kernel locals math
       math.functions math.geometry math.ranges opengl opengl.gl
       opengl.glu processing.shapes sequences ui.gadgets
       ui.gadgets.worlds ui.render ui ui.gadgets.panes ;

IN: sine-gadget-ortho

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 
! Make a 'setup-viewport' word.
!
! This is an interface to 'gl-viewport' which establishes a viewport
! for a particular gadget in a window.
!
! Such a utility word should probably be offered as a part of the core
! ui library.
! 
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: screen-y* ( gadget -- loc )
  { [ find-world height ] [ screen-loc second ] [ height ] } cleave + - ;

: screen-loc* ( gadget -- loc )
  { [ screen-loc first ] [ screen-y* ] } cleave 2array ;

: setup-viewport ( gadget -- gadget )
  dup { [ screen-loc* ] [ dim>> ] } cleave gl-viewport ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: ortho* ( gadget left right bottom top quot -- )
  GL_PROJECTION glMatrixMode glPushMatrix glLoadIdentity
  [ gluOrtho2D ] dip
  GL_MODELVIEW glMatrixMode glPushMatrix glLoadIdentity
  [ setup-viewport ] dip
  call
  GL_PROJECTION glMatrixMode glPopMatrix glLoadIdentity
  GL_MODELVIEW  glMatrixMode glPopMatrix glLoadIdentity
  dup find-world
  { [ drop 0 ] [ width ] [ height ] [ drop 0 ] } cleave -1 1 glOrtho
  dup find-world setup-viewport drop
  drop ; inline

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Implement '<sine-gadget>'
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! A gadget which draws plots the sine curve from -10 to 10

TUPLE: <sine-gadget> < gadget ;

! Have a default size of 400x400

M: <sine-gadget> pref-dim* ( <sine-gadget> -- dim ) drop { 400 400 } ;

! Where all the magic happens

M:: <sine-gadget> draw-gadget* ( SINE -- )

  SINE -10 10 -10 10
    [
      -10 10 0.5 <range> [ dup sin 2array ] map line-strip
      fill-mode
    ]
  ortho* ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! These words demo the gadget. The first will open <sine-gadget> in a
! new window. The second will output a <sine-gadget> to the listener
! history.

: sine-gadget-window ( -- ) <sine-gadget> new-gadget "Sine" open-window ;
: sine-gadget.       ( -- ) <sine-gadget> new-gadget gadget.            ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! Go forth, and write elegant Factor gadgets.