Paste: Classic Temperature constraint system example

Author: dharmatech
Mode: factor
Date: Thu, 4 Dec 2008 19:35:55
Plain Text | 
USING: quotations
       math.functions
       math.parser
       models
       models.range
       models.filter
       ui
       ui.gadgets
       ui.gadgets.labels
       ui.gadgets.packs
       ui.gadgets.sliders
       sto ;

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

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

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

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

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

<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
    
"test" open-window

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

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

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

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

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

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

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

New Annotation

Summary:
Author:
Mode:
Body: