Paste: Classic temperature conversion constraint system

USING: quotations
       math.functions
       math.parser
       models
       models.range
       models.filter
       ui
       ui.gadgets
       ui.gadgets.labels
       ui.gadgets.packs
       ui.gadgets.sliders
       sto ;

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

! This is the classic temperature conversion constraint system
! example.
!
! There are two models, one for Fahrenheit and one for Celsius.
!
! Each has a corresponding control, manifest as a horizontal slider.
!
! At the end, we tie the two models together, so that when one
! changes, the other is updated.

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

! It's sort of not recommended to put really dynamic stuff like 'call'
! in prominent methods like 'model-changed'. However, soon Factor will
! be able to handle stuff like this in a robust fasion that won't
! bring down performance.

M: callable model-changed ( model observer -- ) call ;

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

! Define the two models

50 1 32 212 <range> sto FAHRENHEIT-RANGE-MODEL
  
50 1 0 100 <range> sto CELSIUS-RANGE-MODEL

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

! Build the ui

<pile> 1 >>fill
  
  <shelf>
    "Fahrenheit:" <label> add-gadget
    FAHRENHEIT-RANGE-MODEL
      [ first round number>string ] <filter> <label-control>
    add-gadget
  add-gadget
  FAHRENHEIT-RANGE-MODEL <x-slider> add-gadget
  
  <shelf>
    "Celsius:" <label> add-gadget
    CELSIUS-RANGE-MODEL
      [ first round number>string ] <filter> <label-control>
    add-gadget
  add-gadget
  CELSIUS-RANGE-MODEL <x-slider> add-gadget
    
"Temperature" open-window

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

! Standard conversion formulas

: f->c ( f -- c ) 32 - 5/9 * ;

: c->f ( c -- f ) 9/5 * 32 + ;

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

! Add a connection. When Fahrenheit changes, update Celsius.

[
  drop
  FAHRENHEIT-RANGE-MODEL range-value f->c CELSIUS-RANGE-MODEL set-range-value
]
FAHRENHEIT-RANGE-MODEL
add-connection

! Add a connection. When Celsius changes, update Fahrenheit.

[
  drop
  CELSIUS-RANGE-MODEL range-value c->f FAHRENHEIT-RANGE-MODEL set-range-value
]
CELSIUS-RANGE-MODEL
add-connection

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