Skip to content

Instantly share code, notes, and snippets.

@greggirwin
Last active October 23, 2017 19:53
Show Gist options
  • Save greggirwin/5af03a6ed90a9a38da0a1201da2cf31e to your computer and use it in GitHub Desktop.
Save greggirwin/5af03a6ed90a9a38da0a1201da2cf31e to your computer and use it in GitHub Desktop.
Interactive trig function laboratory
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment