Interactive trig function laboratory

trig-lab.red

Red [
	Title:   "trig-lab.red"
	Author:  "Gregg Irwin"
	File: 	 %trig-lab.red
	Needs:	 'View
	Purpose: {
		See %math-lab comments for details. This script focuses 
		on trigonometric functions.
	}
]

;-------------------------------------------------------------------------------
;-- General purpose mezzanines

decr: function [
	"Decrements a value or series index"
	value [scalar! series! any-word! any-path!] "If value is a word, it will refer to the decremented value"
	/by "Change by this amount"
		amount [scalar!]
][
	incr/by value negate any [amount 1]
]

incr: function [
	"Increments a value or series index."
	value [scalar! series! any-word! any-path!] "If value is a word, it will refer to the incremented value"
	/by "Change by this amount"
		amount [scalar!]
][
	amount: any [amount 1]
	
	if integer? value [return add value amount]			;-- This speeds up our most common case by 4.5x
														;	though we are still 5x slower than just adding 
														;	1 to an int directly and doing nothing else.

	; All this just to be smart about incrementing percents.
	if all [
		integer? amount
		1 = absolute amount
		any [percent? value  percent? attempt [get value]]
	][amount: to percent! (1% * sign? amount)]			;-- % * int == float, so we cast.
		
	case [
		scalar? value [add value amount]
		any [
			any-word? value
			any-path? value								;!! Check any-path? before series?.
		][
			op: either series? get value [:skip] [:add]
			set value op get value amount
			:value                                      ;-- Return the word for chaining calls.
		]
		series? value [skip value amount]
	]
]

scalar?: func [
	"Returns true if value is any type of scalar value"
	value [any-type!]
][
	find scalar! type? :value
]

;-------------------------------------------------------------------------------
;-- App-specific support

args: make reactor! [							;-- This is where the arg texts get their values, reactively.
	arg-1: 0
	arg-2: 0
]


arity-1-ops: [									;-- We can determine arity dynamically, but it's overkill here.
	arccosine arcsine arctangent cosine sine tangent     	
	asin atan acos cos sin tan
]
arity-1?: func [op][find arity-1-ops op]

handle-arg-key: func [face [object!] key [char! word!]][
	switch key [
	    up   [step-face face :incr]
	    down [step-face face :decr]
	]
]

load-num: function [str][						;-- This is obviously basic
	res: attempt [load str]
	if any [none? res  block? res][res: 0]
	res
]

set-args: func [a][	; b						;-- How the buttons set the arg fields
	f-arg-1/data: a
	;f-arg-2/data: b
]

step-face: func [face fn][
	face/text: mold fn load-num face/text		;-- MOLD is used, instead of FORM, for char! values
]

;-------------------------------------------------------------------------------
; UI

show-help: does [
	view/flags [
	    text 400x220 {  Enter values in the arg fields. As you do, changes will immediately
  be reflected for each operation, with the results shown after the
  == label. If no value appears there, it means the operation is not
  valid for the args.
  
  If the second arg column is empty, it means the operation on that
  line is a single arity function (takes just 1 arg).
  
  You can use the up/down arrow keys in the arg fields to increment
  the values up and down.
  
  The buttons at the top will preload the arg fields with values of
  different types, to show you some possibilities you might not know
  about.}
		button "Close" [unview]
	][modal]
]

show-spec: func [op][
	op: to word! op
	view/flags compose [
		text (mold op)
		text 500x300 (mold get op)
	][modal]
]

note-text: trim/lines {
	NOTE: While some functions may seem to be simple 
	shortcut names, they are not always. It may be that one version 
	takes the angle parameter in radians, while the other takes it in
	degrees. The latter have a /radians refinement however.
}
  
; We start with a static "header" area in our layout. Then we'll add a
; bunch of other stuff dynamically.
lay-spec: copy [
	title "Red Trig Lab"
	space 4x2

	pad 2x0
    text 375x60 note-text
    return
    pad 0x5

	button "0"		[set-args 0]
	button "90"		[set-args 90]
	button "180"	[set-args 180]
	button "270"	[set-args 270]
	button "-180"	[set-args -180]
	pad 10x0
	button "Help" 	[show-help]
	return
	button "0.0"	[set-args 0.0]
	button "90.0"	[set-args 90.0]
	button "180.0"	[set-args 180.0]
	button "270.0"	[set-args 270.0]
	button "-180.0"	[set-args -180.0]
	pad 10x0
	button "Quit" [quit]
	return
	button "0.0"	[set-args 0.0]
	button "0.25"	[set-args 0.25]
	button "0.5"	[set-args 0.5]
	button "0.75"	[set-args 0.75]
	button "1.0"	[set-args 1.0]
	return
	pad 0x10
	
	text "Args" 100x18 right
	pad 12x0
	style arg-fld: field 60 center on-key [handle-arg-key face event/key]
	f-arg-1: arg-fld "0"
	f-arg-2: arg-fld "0"
	return
	pad 0x10
	
	;-- It might seem silly to have so many styles in such a small script, when
	;	they don't add functionality. They're here largely to make the layout
	;	spec more clear in its intent, describing what each face is. In a dynamic
	;	script, where you never see the generated code, it may not matter, but
	;	sometimes you may start out with a dynamic plan, and later decide that
	;	you can just copy the generated code and paste it in somewhere. Or you
	;	may write code generators, but only want to distribute static layouts for
	;	easier maintenance.
	style text: text 60x18 center
	style arg-1-ref: text ;extra 'arg-1
	style arg-2-ref: text ;extra 'arg-2
	style spacer:    text ""
	style op-lbl:    text 100x18 right on-down [show-spec face/extra] on-over [
		f-tip/text: either event/away? [""][first spec-of get to word! face/extra]
	]
	style op-result: text 115x18 left

	pad 2x0
	f-tip: text bold font-color navy left 350x60 para [wrap?: on] return
	
	;!! IMPORTANT: This is how everything propagates reactively. It tells our
	;	'args reactor to respond to changes in the arg field faces. When the
	;	user changes a field it reactively triggers 'load-num which converts
	;	the text to a number and updates 'args. In turn, as you will see below,
	;	all the faces that mirror changes to the args react to 'args changing.
	react [
		args/arg-1: load-num f-arg-1/text
		args/arg-2: load-num f-arg-2/text
	]
]

;-- This function dynamically adds all the necessary components to the layout
;	for a give math op. 
add-op: function [op][
	;!! You MUST use copy/deep for reactor blocks to work properly, because
	;	each is uniquely related to its associated face object.
	append lay-spec compose/deep copy/deep [

		;ii The two parens here, with set-word!/lit-word! conversions in them,
		;ii are not needed in this app, but they show how you can dynamically
		;ii generate words that will refer to the faces, and tag them with 
		;ii extra data for later use.
		;(to set-word! append copy "f-op-" op) 
		op-lbl (form op) extra (form op)
		pad 10x0

		;-- Here we add our 2 arg "mirror" labels, that reflect changes to the
		;   fields. Note that we set up a static relation to the arg fields,
		;	since all we want to do is mirror their text. But the next two
		;	commented lines show how we could also react to the 'args reactor!
		arg-1-ref react [face/text: f-arg-1/text]
		(either arity-1? op ['spacer][ [arg-2-ref react [face/text: f-arg-2/text]] ])
		;arg-1-ref react [face/text: form args/arg-1]
		;(either arity-1? op ['spacer][ [arg-2-ref react [face/text: form args/arg-2]] ])

		text 25 "=="

		;-- This is our "output" text, showing the result of each op applied
		;	to the args the user entered.
		op-result react [
			;-- Wrap things in ATTEMPT to catch errors. We could add more 
			;	details later if it proves helpful.
			face/text: attempt [
				;ii In our reactors above, we relate directly to the arg fields.
				;ii But here we use the 'args reactor! because it has already
				;ii done the work of converting the text to numbers for us, to
				;ii apply the op to.
				;ii Don't forget that we're still generating layout data here!
				;ii And generating reactors only for the args an op uses.
				form (to word! op) args/arg-1 (either arity-1? op [][ [args/arg-2] ])
				;form (to word! op) load-num f-arg-1/text (either arity-1? op [][ [load-num f-arg-2/text] ])
			]
		]

		return
	]	
]

;-- This is what drives the above function, to dynamically generate the
;	faces and all their reactive relations in the layout. We just define
;	the list of operations we want to include, and and add each one.
ops: [
     arctangent2    ; =>  Returns the angle of the point y/x in radians, when measured counterclockwise from a circle's x axis (where 0x0 represents the center of the circle). The return value is between -pi and +pi.
     atan2    		; =>  Returns the angle of the point y/x in radians, when measured counterclockwise from a circle's x axis (where 0x0 represents the center of the circle). The return value is between -pi and +pi.

     arccosine    	; =>  Returns the trigonometric arccosine (in degrees by default)
     arcsine    	; =>  Returns the trigonometric arcsine (in degrees by default)
     arctangent    	; =>  Returns the trigonometric arctangent (in degrees by default)
     cosine    		; =>  Returns the trigonometric cosine
     sine    		; =>  Returns the trigonometric sine
     tangent    	; =>  Returns the trigonometric tangent

     asin    		; =>  Returns the trigonometric arcsine
     atan    		; =>  Returns the trigonometric arctangent
     acos    		; =>  Returns the trigonometric arccosine
     cos    		; =>  Returns the trigonometric cosine
     sin    		; =>  Returns the trigonometric sine
     tan    		; =>  Returns the trigonometric tangent
]
foreach op ops [add-op op]

;print mold lay-spec							;-- View the generated layout spec.
view lay-spec