Page Numbers: Yes First Page: 1
Heading:
October 6, 1977 12:45 AM[IFS]<KRL>code>actionClasses.bravo
# # # # # # # # # # # # # # #
[ActionClassPrototype (self message)
(* this is a function for an action type. In order to avoid name conflicts, those action types
which correspond to the top-level functions are prefixed with #.)
(SELECTQ message
(EXPAND (* self is the action for all of these. result, bindings,
newActions, unexpandedActions completedActions and
noEffectActions are all bound. Returns non-NIL if the
action has an effect (either direct or by subactions))
(DO)
(HELP "bad message to goal function")]
[#AddDescriptor ((self Action)(message ActionMessage))
(* this is a function for an action type. arg is descriptor to be added to top element of binding)
(SELECTQ message
(EXPAND T)
(PROCEDURES (ChangeDescription self self:actionSpec:actionArg))
(DO (IncludeHandle self:actionArg self:actionBinding:1 descrs))
(HELP "bad message to goal function")]
[#AddElement ((self Action)(message ActionMessage))
(* this is a function for an action type. arg is anchor to be added to top element of binding, which is an enumeration, test is where)
(SELECTQ message
(EXPAND T)
(DO (SELECTQ self:actionSpec:actionTest
(AddBefore
(InsertHandle self:actionArg
(FindHandle self:actionBinding:1
self:actionBinding:2
elements
(ConstantHandle))
(ConstantHandle)))
(AddAfter
(AppendHandle self:actionArg
(FindHandle self:actionBinding:1
self:actionBinding:2
elements
(ConstantHandle))
(ConstantHandle)))
(AddElement
(IncludeHandle self:actionArg
self:actionBinding:1
elements
NIL
(EQ (TypeD self:actionBinding:1) ’Sequence)))
(KHelp "illegal specification for AddElement" self)))
(HELP "bad message to goal function")]
[#AddPair ((self Action)(message ActionMessage))
(* this is a function for an action type. arg is instance to be added to top element of binding, test is template)
(SELECTQ message
(EXPAND T)
(DO (DPROG((mapD self:actionBinding:1 MapDescriptor)))
(IncludeHandle self:actionTest mapD templateAnchors)
(IncludeHandle self:actionArg mapD instanceAnchors))))
(HELP "bad message to goal function")]
[#ChangeElement ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND
(DPROG ((spec self:actionSpec ActionForm)
(path NIL (LISTP OF DHandle))
(anchor NIL Anchor)
(actionType self:actionForm:actionType LITATOM)
THEN (types (SELECTQ actiontype
((AddBefore AddAfter) ’(Sequence))
’(Sequence Set))
(LISTP OF (ONEOF Set Sequence))))
(if (EQ spec:actionTest ’ME)
then (if (AND (FMEMB (KrlType spec:actionBinding:2) types)
(FMEMB spec:actionCount ’(NIL 1 ALL)))
then (path ← self:actionBindings)
else (KHelp "illegal use of ME in Action" self:actionForm))
elseif (NOT (path ← (RunGoal (MakeNewFindGoal NIL self:actionForm))))
then (KHelp "element not found" self))
(anchor ← (KrlCreate Anchor (SpaceName path:1 (ConstantHandle))))
(if (EQ actionType ’SubstituteElement)
then (SubAction self ’#ClobberElement anchor path)
else (SubAction self ’#AddElement anchor path actionType))
(SubAction self
’#Describe
self:actionSpec:actionArg
<anchor ! (if (EQ actionType ’AddElement)
then path else path::1)>
NIL
T)))
(DO)
(HELP "bad message to goal function")]
[#ChangeDescriptor ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND
(DPROG ((spec self:actionSpec ActionForm)
(path NIL (LISTP OF DHandle))
THEN (arg spec:actionArg (ONEOF Anchor Descriptor))
(actionType self:actionForm:actionType LITATOM))
(if (EQ spec:actionTest ’ME)
then (if (AND (EQ (TypeK spec:actionBinding:2) ’Descriptor)
(FMEMB spec:actionCount ’(NIL 1 ALL)))
then (path ← self:actionBindings)
else (KHelp "illegal use of ME in Action" self:actionForm))
elseif (NOT (path ← (RunGoal (MakeNewFindGoal NIL self))))
then (KHelp "descriptor not found" self))
(arg ←
(SELECTQ (TypeK arg)
(Descriptor arg)
(Anchor (if (HasSingleDescriptor arg)
then (NthHandle arg descrs 1 (ConstantHandle))
else (KHelp "Descriptor action - arg not descriptor" self)))
(KHelp "Descriptor action with arg not descriptor" self)))
(arg ← (KrlCopy arg (SpaceName path:1 (ConstantHandle))))
(if (EQ actionType ’SubstituteDescriptor)
then (SubAction self ’#ClobberDescriptor descriptor path)
else (SubAction self ’#AddDescriptor descriptor path actionType)))
(DO T)
(HELP "bad message to goal function")]
[#ClobberDescriptor ((self Action)(message ActionMessage))
(* this is a class for an action type.. arg is object to replace one at top of bindings)
(SELECTQ message
(EXPAND T)
(DO (DPROG((path self:actionBinding (LISTP OF DHandle))
THEN(pointer (FindHandle path:1 path:2 descrs) Handle))
(NullifyHandle pointer)
(IncludeHandle self:actionSpec:actionArg pointer)))
(HELP "bad message to goal function")]
[#ClobberElement ((self Action)(message ActionMessage))
(* this is a class for an action type.. arg is object to replace one at top of bindings)
(SELECTQ message
(EXPAND T)
(DO (DPROG((path self:actionBinding (LISTP OF DHandle))
THEN(pointer (FindHandle path:1 path:2 elements) Handle))
(NullifyHandle pointer)
(IncludeHandle self:actionSpec:actionArg pointer)))
(HELP "bad message to goal function")]
[#Describe ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND
(DPROG ((spec self:actionSpec ActionForm)
THEN (describe T BOOL)
(overWrite spec:actionTest BOOL)
(actions
(RunGoal (Create Goal
goalType ← ’AlignAnchor
goalDesc ← spec:actionArg
datum ← self:actionBinding:1
anchorPath ← self:actionBinding
resultType ← ’AlignForDescribe)
(LISTP OF Action)))
(if actions
then (for action in actions
do (action:actionParent ← self)
(PUSH actions action))
else self:actionSpec:actionTest ← ’NOEFFECT)))
(PROCEDURES T (* all handled by subactions))
(DO T)
(HELP "bad message to goal function")]
[#MetaDescribe ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND (SubAction self
’#Describe
self:actionArgValue
<(GetMetaAnchor self:actionBinding:1)>
NIL
T))
(DO T)
(HELP "bad message to goal function")]
[#Substitute ((self Action)(message ActionMessage))
(* this is a class for an action type..)
(SELECTQ message
(EXPAND
(SubAction self ’#ClearAnchor
NIL
self:actionBinding)
(SubAction self ’#Describe
self:actionArgValue
self:actionBinding:1
T)
(PROCEDURES T)
(DO T)
(HELP "bad message to goal function")]
# # # # # # # # # # # # # # #