module Csound.Typed.Opcode.Strings (
    
    
    -- * Definition.
    strfromurl, strget, strset,
    
    -- * Manipulation.
    puts, sprintf, sprintfk, strcat, strcatk, strcmp, strcmpk, strcpy, strcpyk, strindex, strindexk, strlen, strlenk, strrindex, strrindexk, strsub, strsubk,
    
    -- * Conversion.
    strchar, strchark, strlower, strlowerk, strtod, strtodk, strtol, strtolk, strupper, strupperk) where

import Control.Monad.Trans.Class
import Csound.Dynamic
import Csound.Typed

-- Definition.

-- | 
-- Set string variable to value read from an URL
--
-- strfromurl sets a string variable at
--       initialization time to the value found from reading an URL.
--
-- > Sdst  strfromurl  StringURL
--
-- csound doc: <http://csound.com/docs/manual/strfromurl.html>
strfromurl ::  Str -> Str
strfromurl :: Str -> Str
strfromurl Str
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strfromurl" [(Rate
Sr,[Rate
Sr])] [E
a1]

-- | 
-- Set string variable to value from strset table or string p-field
--
-- strget sets a string variable at initialization time to the value stored in strset table at the specified index, or a string p-field from the score. If there is no string defined for the index, the variable is set to an empty string.
--
-- > Sdst  strget  indx
--
-- csound doc: <http://csound.com/docs/manual/strget.html>
strget ::  D -> Str
strget :: D -> Str
strget D
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strget" [(Rate
Sr,[Rate
Ir])] [E
a1]

-- | 
-- Allows a string to be linked with a numeric value.
--
-- >  strset  iarg, istring
--
-- csound doc: <http://csound.com/docs/manual/strset.html>
strset ::  D -> D -> SE ()
strset :: D -> D -> SE ()
strset D
b1 D
b2 = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ (E -> Dep ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> Dep ()) -> DepT GE E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (DepT GE E -> Dep ()) -> DepT GE E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> DepT GE E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> DepT GE E) -> GE E -> DepT GE E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> GE E
unD D
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D -> GE E
unD D
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strset" [(Rate
Xr,[Rate
Ir,Rate
Ir])] [E
a1,E
a2]

-- Manipulation.

-- | 
-- Print a string constant or variable
--
-- puts prints a string with an optional newline at the end whenever the trigger signal is positive and changes.
--
-- >  puts  Sstr, ktrig[, inonl]
--
-- csound doc: <http://csound.com/docs/manual/puts.html>
puts ::  Str -> Sig -> SE ()
puts :: Str -> Sig -> SE ()
puts Str
b1 Sig
b2 = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ (E -> Dep ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> Dep ()) -> DepT GE E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (DepT GE E -> Dep ()) -> DepT GE E -> Dep ()
forall a b. (a -> b) -> a -> b
$ GE E -> DepT GE E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE E -> DepT GE E) -> GE E -> DepT GE E
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"puts" [(Rate
Xr,[Rate
Sr,Rate
Kr,Rate
Ir])] [E
a1,E
a2]

-- | 
-- printf-style formatted output to a string variable.
--
-- sprintf write printf-style formatted output to a string variable, similarly to the C function sprintf(). sprintf runs at i-time only.
--
-- > Sdst  sprintf  Sfmt, xarg1[, xarg2[, ... ]]
--
-- csound doc: <http://csound.com/docs/manual/sprintf.html>
sprintf ::  Str -> Sig -> Str
sprintf :: Str -> Sig -> Str
sprintf Str
b1 Sig
b2 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"sprintf" [(Rate
Sr,[Rate
Sr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Xr))] [E
a1,E
a2]

-- | 
-- printf-style formatted output to a string variable at k-rate.
--
-- sprintfk writes printf-style formatted output to a string variable, similarly to the C function sprintf(). sprintfk runs both at initialization and performance time.
--
-- > Sdst  sprintfk  Sfmt, xarg1[, xarg2[, ... ]]
--
-- csound doc: <http://csound.com/docs/manual/sprintfk.html>
sprintfk ::  Str -> Sig -> Str
sprintfk :: Str -> Sig -> Str
sprintfk Str
b1 Sig
b2 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"sprintfk" [(Rate
Sr,[Rate
Sr] [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ (Rate -> [Rate]
forall a. a -> [a]
repeat Rate
Xr))] [E
a1,E
a2]

-- | 
-- Concatenate strings
--
-- Concatenate two strings and store the result in a variable. strcat runs at i-time only. It is allowed for any of the input arguments to be the same as the output variable.
--
-- > Sdst  strcat  Ssrc1, Ssrc2
--
-- csound doc: <http://csound.com/docs/manual/strcat.html>
strcat ::  Str -> Str -> Str
strcat :: Str -> Str -> Str
strcat Str
b1 Str
b2 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strcat" [(Rate
Sr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Concatenate strings (k-rate)
--
-- Concatenate two strings and store the result in a variable. strcatk does the concatenation both at initialization and performance time. It is allowed for any of the input arguments to be the same as the output variable.
--
-- > Sdst  strcatk  Ssrc1, Ssrc2
--
-- csound doc: <http://csound.com/docs/manual/strcatk.html>
strcatk ::  Str -> Str -> Str
strcatk :: Str -> Str -> Str
strcatk Str
b1 Str
b2 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strcatk" [(Rate
Sr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Compare strings
--
-- Compare strings and set the result to -1, 0, or 1 if the first string is less than, equal to, or greater than the second, respectively. strcmp compares at i-time only.
--
-- > ires  strcmp  S1, S2
--
-- csound doc: <http://csound.com/docs/manual/strcmp.html>
strcmp ::  Str -> Str -> D
strcmp :: Str -> Str -> D
strcmp Str
b1 Str
b2 = GE E -> D
D (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strcmp" [(Rate
Ir,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Compare strings
--
-- Compare strings and set the result to -1, 0, or 1 if the first string is less than, equal to, or greater than the second, respectively. strcmpk does the comparison both at initialization and performance time.
--
-- > kres  strcmpk  S1, S2
--
-- csound doc: <http://csound.com/docs/manual/strcmpk.html>
strcmpk ::  Str -> Str -> Sig
strcmpk :: Str -> Str -> Sig
strcmpk Str
b1 Str
b2 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strcmpk" [(Rate
Kr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Assign value to a string variable
--
-- Assign to a string variable by copying the source which may be a constant or another string variable. strcpy and = copy the string at i-time only.
--
-- > Sdst  strcpy  Ssrc
--
-- csound doc: <http://csound.com/docs/manual/strcpy.html>
strcpy ::  Str -> Str
strcpy :: Str -> Str
strcpy Str
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strcpy" [(Rate
Sr,[Rate
Sr])] [E
a1]

-- | 
-- Assign value to a string variable (k-rate)
--
-- Assign to a string variable by copying the source which may be a constant or another string variable. strcpyk does the assignment both at initialization and performance time.
--
-- > Sdst  strcpyk  Ssrc
--
-- csound doc: <http://csound.com/docs/manual/strcpyk.html>
strcpyk ::  Str -> Str
strcpyk :: Str -> Str
strcpyk Str
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strcpyk" [(Rate
Sr,[Rate
Sr])] [E
a1]

-- | 
-- Return the position of the first occurence of a string in another string
--
-- Return the position of the first occurence of S2 in S1, or -1 if not
--       found. If S2 is empty, 0 is returned. strindex runs at init time only.
--
-- > ipos  strindex  S1, S2
--
-- csound doc: <http://csound.com/docs/manual/strindex.html>
strindex ::  Str -> Str -> D
strindex :: Str -> Str -> D
strindex Str
b1 Str
b2 = GE E -> D
D (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strindex" [(Rate
Ir,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Return the position of the first occurence of a string in another string
--
-- Return the position of the first occurence of S2 in S1, or -1 if not
--       found. If S2 is empty, 0 is returned. strindexk runs both at init and
--       performance time.
--
-- > kpos  strindexk  S1, S2
--
-- csound doc: <http://csound.com/docs/manual/strindexk.html>
strindexk ::  Str -> Str -> Sig
strindexk :: Str -> Str -> Sig
strindexk Str
b1 Str
b2 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strindexk" [(Rate
Kr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Return the length of a string
--
-- Return the length of a string, or zero if it is empty. strlen runs at init time only.
--
-- > ilen  strlen  Sstr
--
-- csound doc: <http://csound.com/docs/manual/strlen.html>
strlen ::  Str -> D
strlen :: Str -> D
strlen Str
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strlen" [(Rate
Ir,[Rate
Sr])] [E
a1]

-- | 
-- Return the length of a string
--
-- Return the length of a string, or zero if it is empty. strlenk runs both at init and performance time.
--
-- > klen  strlenk  Sstr
--
-- csound doc: <http://csound.com/docs/manual/strlenk.html>
strlenk ::  Str -> Sig
strlenk :: Str -> Sig
strlenk Str
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strlenk" [(Rate
Kr,[Rate
Sr])] [E
a1]

-- | 
-- Return the position of the last occurence of a string in another string
--
-- Return the position of the last occurence of S2 in S1, or -1 if not
--       found. If S2 is empty, the length of S1 is returned. strrindex runs
--       at init time only.
--
-- > ipos  strrindex  S1, S2
--
-- csound doc: <http://csound.com/docs/manual/strrindex.html>
strrindex ::  Str -> Str -> D
strrindex :: Str -> Str -> D
strrindex Str
b1 Str
b2 = GE E -> D
D (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strrindex" [(Rate
Ir,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Return the position of the last occurence of a string in another string
--
-- Return the position of the last occurence of S2 in S1, or -1 if not
--       found. If S2 is empty, the length of S1 is returned. strrindexk runs
--       both at init and performance time.
--
-- > kpos  strrindexk  S1, S2
--
-- csound doc: <http://csound.com/docs/manual/strrindexk.html>
strrindexk ::  Str -> Str -> Sig
strrindexk :: Str -> Str -> Sig
strrindexk Str
b1 Str
b2 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E -> E
f (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Str -> GE E
unStr Str
b2
    where f :: E -> E -> E
f E
a1 E
a2 = Name -> Spec1 -> [E] -> E
opcs Name
"strrindexk" [(Rate
Kr,[Rate
Sr,Rate
Sr])] [E
a1,E
a2]

-- | 
-- Extract a substring
--
-- Return a substring of the source string. strsub runs at init time only.
--
-- > Sdst  strsub  Ssrc[, istart[, iend]]
--
-- csound doc: <http://csound.com/docs/manual/strsub.html>
strsub ::  Str -> Str
strsub :: Str -> Str
strsub Str
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strsub" [(Rate
Sr,[Rate
Sr,Rate
Ir,Rate
Ir])] [E
a1]

-- | 
-- Extract a substring
--
-- Return a substring of the source string. strsubk runs both at init and
--       performance time.
--
-- > Sdst  strsubk  Ssrc, kstart, kend
--
-- csound doc: <http://csound.com/docs/manual/strsubk.html>
strsubk ::  Str -> Sig -> Sig -> Str
strsubk :: Str -> Sig -> Sig -> Str
strsubk Str
b1 Sig
b2 Sig
b3 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E
f (E -> E -> E -> E) -> GE E -> GE (E -> E -> E)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1 GE (E -> E -> E) -> GE E -> GE (E -> E)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b2 GE (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
unSig Sig
b3
    where f :: E -> E -> E -> E
f E
a1 E
a2 E
a3 = Name -> Spec1 -> [E] -> E
opcs Name
"strsubk" [(Rate
Sr,[Rate
Sr,Rate
Kr,Rate
Kr])] [E
a1,E
a2,E
a3]

-- Conversion.

-- | 
-- Return the ASCII code of a character in a string
--
-- Return the ASCII code of the character in Sstr at ipos (defaults to zero
--       which means the first character), or zero if ipos is out of range.
--       strchar runs at init time only.
--
-- > ichr  strchar  Sstr[, ipos]
--
-- csound doc: <http://csound.com/docs/manual/strchar.html>
strchar ::  Str -> D
strchar :: Str -> D
strchar Str
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strchar" [(Rate
Ir,[Rate
Sr,Rate
Ir])] [E
a1]

-- | 
-- Return the ASCII code of a character in a string
--
-- Return the ASCII code of the character in Sstr at kpos (defaults to zero
--       which means the first character), or zero if kpos is out of range.
--       strchark runs both at init and performance time.
--
-- > kchr  strchark  Sstr[, kpos]
--
-- csound doc: <http://csound.com/docs/manual/strchark.html>
strchark ::  Str -> Sig
strchark :: Str -> Sig
strchark Str
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strchark" [(Rate
Kr,[Rate
Sr,Rate
Kr])] [E
a1]

-- | 
-- Convert a string to lower case
--
-- Convert Ssrc to lower case, and write the result to Sdst.
--       strlower runs at init time only.
--
-- > Sdst  strlower  Ssrc
--
-- csound doc: <http://csound.com/docs/manual/strlower.html>
strlower ::  Str -> Str
strlower :: Str -> Str
strlower Str
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strlower" [(Rate
Sr,[Rate
Sr])] [E
a1]

-- | 
-- Convert a string to lower case
--
-- Convert Ssrc to lower case, and write the result to Sdst.
--       strlowerk runs both at init and performance time.
--
-- > Sdst  strlowerk  Ssrc
--
-- csound doc: <http://csound.com/docs/manual/strlowerk.html>
strlowerk ::  Str -> Str
strlowerk :: Str -> Str
strlowerk Str
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strlowerk" [(Rate
Sr,[Rate
Sr])] [E
a1]

-- | 
-- Converts a string to a float (i-rate).
--
-- Convert a string to a floating point value. It is also possible to
--     pass an strset index or a string p-field from the score instead of a string
--     argument. If the string cannot be parsed as a floating point or integer number, an init or perf error occurs and the instrument is deactivated.
--
-- > ir  strtod  Sstr
-- > ir  strtod  indx
--
-- csound doc: <http://csound.com/docs/manual/strtod.html>
strtod ::  Str -> D
strtod :: Str -> D
strtod Str
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strtod" [(Rate
Ir,[Rate
Sr]),(Rate
Ir,[Rate
Ir])] [E
a1]

-- | 
-- Converts a string to a float (k-rate).
--
-- Convert a string to a floating point value at i- or k-rate. It is also possible to pass an strset index or a string p-field from the score instead of a string
--     argument. If the string cannot be parsed as a floating point or integer number, an init or perf error occurs and the instrument is deactivated.
--
-- > kr  strtodk  Sstr
-- > kr  strtodk  kndx
--
-- csound doc: <http://csound.com/docs/manual/strtodk.html>
strtodk ::  Str -> Sig
strtodk :: Str -> Sig
strtodk Str
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strtodk" [(Rate
Kr,[Rate
Sr]),(Rate
Kr,[Rate
Kr])] [E
a1]

-- | 
-- Converts a string to a signed integer (i-rate).
--
-- Convert a string to a signed integer value. It is also possible to
--     pass an strset index or a string p-field from the score instead of a string
--     argument. If the string cannot be parsed as an integer number, an init error occurs and the instrument is deactivated.
--
-- > ir  strtol  Sstr
-- > ir  strtol  indx
--
-- csound doc: <http://csound.com/docs/manual/strtol.html>
strtol ::  Str -> D
strtol :: Str -> D
strtol Str
b1 = GE E -> D
D (GE E -> D) -> GE E -> D
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strtol" [(Rate
Ir,[Rate
Sr]),(Rate
Ir,[Rate
Ir])] [E
a1]

-- | 
-- Converts a string to a signed integer (k-rate).
--
-- Convert a string to a signed integer value at i- or k-rate. It is also possible to pass an strset index or a string p-field from the score instead of a string
--     argument. If the string cannot be parsed as an integer number, an init or perf error occurs and the instrument is deactivated.
--
-- > kr  strtolk  Sstr
-- > kr  strtolk  kndx
--
-- csound doc: <http://csound.com/docs/manual/strtolk.html>
strtolk ::  Str -> Sig
strtolk :: Str -> Sig
strtolk Str
b1 = GE E -> Sig
Sig (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strtolk" [(Rate
Kr,[Rate
Sr]),(Rate
Kr,[Rate
Kr])] [E
a1]

-- | 
-- Convert a string to upper case
--
-- Convert Ssrc to upper case, and write the result to Sdst.
--       strupper runs at init time only.
--
-- > Sdst  strupper  Ssrc
--
-- csound doc: <http://csound.com/docs/manual/strupper.html>
strupper ::  Str -> Str
strupper :: Str -> Str
strupper Str
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strupper" [(Rate
Sr,[Rate
Sr])] [E
a1]

-- | 
-- Convert a string to upper case
--
-- Convert Ssrc to upper case, and write the result to Sdst.
--       strupperk runs both at init and performance time.
--
-- > Sdst  strupperk  Ssrc
--
-- csound doc: <http://csound.com/docs/manual/strupperk.html>
strupperk ::  Str -> Str
strupperk :: Str -> Str
strupperk Str
b1 = GE E -> Str
Str (GE E -> Str) -> GE E -> Str
forall a b. (a -> b) -> a -> b
$ E -> E
f (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Str -> GE E
unStr Str
b1
    where f :: E -> E
f E
a1 = Name -> Spec1 -> [E] -> E
opcs Name
"strupperk" [(Rate
Sr,[Rate
Sr])] [E
a1]