<<>> <> <> <> <> DIRECTORY EBEditors, EBLanguage, EBTypes, EmbeddedButtons, EBNullDoc, IO, List, Prop, Rope, SymTab; EBNullDocImpl: CEDAR PROGRAM IMPORTS EBEditors, IO, List, Prop, Rope, SymTab EXPORTS EBNullDoc = BEGIN ActiveDoc: TYPE = EBTypes.ActiveDoc; ActiveButton: TYPE = EBTypes.ActiveButton; Variable: TYPE = EBLanguage.Variable; VariableObj: TYPE = EBLanguage.VariableObj; VariableType: TYPE = EBLanguage.VariableType; VariableTypeObj: TYPE = EBLanguage.VariableTypeObj; ROPE: TYPE = Rope.ROPE; <> nullActiveDocClass: EBEditors.ActiveDocClass ¬ NEW[EBEditors.ActiveDocClassObj ¬ [ name: $NullDoc, getRef: NullDocGetRef, setRef: NullDocSetRef, mapRef: NullDocMapRef, getDocName: NullDocGetDocName, feedback: NullDocButtonFeedback, -- Feedback is the name of an interface inButton: NullDocInButton ]]; NullDoc: TYPE = REF NullDocObj; NullDocObj: TYPE = RECORD [ instantiated: BOOL _ FALSE, docName: ROPE, buttons: SymTab.Ref -- maps button names to button datas ]; NullButton: TYPE = REF NullButtonObj; NullButtonObj: TYPE = RECORD [ name: ROPE, -- button name firstValue: NameVariablePair, -- built by Create*Button. First variable and value moreValues: LIST OF NameVariablePair, -- built by Add*Variable. More variables and values propList: Prop.PropList -- built by Instantiate from "firstValue" and "moreValues" fields ]; NameVariablePair: TYPE = RECORD [ name: ROPE, variable: EBLanguage.Variable <> <> <> <> <> <<];>> <> <<];>> ]; NullDocGetRef: EBEditors.GetRefProc = { <> nullButton: NullButton _ NARROW[button]; ref ¬ Prop.Get[nullButton.propList, key]; }; NullDocSetRef: EBEditors.SetRefProc = { <> nullButton: NullButton _ NARROW[button]; nullButton.propList ¬ Prop.Put[nullButton.propList, key, ref]; }; NullDocMapRef: EBEditors.MapRefProc = { <> <> ForEachButton: SymTab.EachPairAction = { <> nullButton: NullButton _ NARROW[val]; quit ¬ mapProc[nullButton, doc]; }; buttons: SymTab.Ref _ NARROW[doc.theDoc, NullDoc].buttons; aborted ¬ SymTab.Pairs[buttons, ForEachButton]; }; NullDocGetDocName: EBEditors.GetDocNameProc ~ { <> name _ NARROW[doc.theDoc, NullDoc].docName; }; NullDocButtonFeedback: EBEditors.FeedbackProc = { <> RETURN[NIL]; }; NullDocInButton: EBEditors.InButtonProc = { RETURN[FALSE]; }; <> <> Create: PUBLIC PROC [docName: ROPE] RETURNS [doc: ActiveDoc] = { nullDoc: NullDoc _ NEW[NullDocObj _ [FALSE, docName, SymTab.Create[]] ]; doc ¬ EBEditors.CreateActiveDoc[nullDoc, nullActiveDocClass]; }; emptyRope: ROPE = ""; semiRope: ROPE = "; "; prefix: ROPE = "Poppy1\nClass: MultiStateButton\nVariables: ("; -- prefix for every button data suffix: ROPE = ")\n"; Instantiate: PUBLIC PROC [doc: ActiveDoc] = { InstantiateEachButton: EmbeddedButtons.EachButtonProc = { <> RopeFromNameVariablePair: PROC [nv: NameVariablePair, semiColon: BOOL] RETURNS [r: ROPE] = { <> SELECT nv.variable.type.class FROM boolean => { r _ IO.PutFR["%g: BOOL = %g%g", [rope[nv.name]], [boolean[NARROW[nv.variable.value, REF BOOL]­]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ]; }; atom => { r _ IO.PutFR["%g: ATOM = %g%g", [rope[nv.name]], [atom[NARROW[nv.variable.value, ATOM]]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ]; }; rope => { r _ IO.PutFR["%g: STRING = \"%g\"%g", [rope[nv.name]], [rope[NARROW[nv.variable.value, ROPE]]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ]; }; integer => { r _ IO.PutFR["%g: INT = %g%g", [rope[nv.name]], [integer[NARROW[nv.variable.value, REF INT]­]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ]; }; real => { r _ IO.PutFR["%g: REAL = %g%g", [rope[nv.name]], [real[NARROW[nv.variable.value, REF REAL]­]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ]; }; enumerated => { <> <> <> <> <> RopeFromEnumeration: PROC [v: VariableType] RETURNS [e: ROPE] = { e _ "{"; -- open curly bracket FOR n: NAT IN [1.. v.count] DO e _ IO.PutFR["%g%g%g", [rope[e]], WITH v[n-1] SELECT FROM z: ROPE => [rope[Rope.Cat["\"", z, "\""]]], z: ATOM => [atom[z]], z: REF INT => [integer[z­]], z: REF REAL => [real[z­]], z: REF BOOL => [boolean[z­]], ENDCASE => [rope["UnknownEnumType"]], IF n [rope[Rope.Cat["\"", z, "\""]]], z: ATOM => [atom[z]], z: REF INT => [integer[z­]], z: REF REAL => [real[z­]], z: REF BOOL => [boolean[z­]], ENDCASE => [rope["UnknownValueType"]], [rope[IF semiColon THEN semiRope ELSE emptyRope]] ] ]; }; ENDCASE => ERROR; }; bdRope: ROPE; buttonData: REF; nB: NullButton _ NARROW[button]; FOR l: LIST OF NameVariablePair _ nB.moreValues, l.rest UNTIL l=NIL DO bdRope _ Rope.Concat[bdRope, RopeFromNameVariablePair[l.first, l.rest#NIL]]; ENDLOOP; bdRope _ Rope.Concat[RopeFromNameVariablePair[nB.firstValue, nB.moreValues # NIL], bdRope]; bdRope _ Rope.Concat[prefix, bdRope]; -- concat the required prefix for buttonData bdRope _ Rope.Concat[bdRope, suffix]; -- concat the required suffix for buttonData bdRope _ Rope.Cat[bdRope, "Name: ", nB.name]; buttonData ¬ EBEditors.ButtonDataFromRope[rope: bdRope, instantiateNow: FALSE, button: button, doc: doc]; NullDocSetRef[key: $ButtonData, ref: buttonData, button: button, doc: doc, edited: FALSE]; }; aborted: BOOL ¬ TRUE; thisDoc: NullDoc _ NARROW[doc.theDoc]; aborted ¬ NullDocMapRef[doc: doc, mapProc: InstantiateEachButton]; IF NOT aborted THEN thisDoc.instantiated _ TRUE; }; <<>> CreateBOOLButton: PUBLIC PROC [doc: ActiveDoc, buttonName: ROPE, initialVarVal: BOOL] RETURNS [ActiveButton] = { button: NullButton; buttons: SymTab.Ref _ NARROW[doc.theDoc, NullDoc].buttons; valRef: REF BOOL _ NEW[BOOL ¬ initialVarVal]; button _ NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: boolean]--], value: valRef]]]]]; button.firstValue.variable.type.class ¬ boolean; [] ¬ SymTab.Store[buttons, buttonName, button]; RETURN[button]; }; AddBOOLVariable: PUBLIC PROC [button: ActiveButton, varName: ROPE, varVal: BOOL] = { nvPair: NameVariablePair; nullButton: NullButton _ NARROW[button]; varValRef: REF BOOL _ NEW[BOOL ¬ varVal]; nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: boolean]--], value: varValRef]] ]; nvPair.variable.type.class ¬ boolean; nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues]; }; CreateATOMButton: PUBLIC PROC [doc: ActiveDoc, buttonName: ROPE, initialVarVal: ATOM] RETURNS [ActiveButton] = { button: NullButton; buttons: SymTab.Ref _ NARROW[doc.theDoc, NullDoc].buttons; <> button _ NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: atom]--], value: initialVarVal]]]]]; button.firstValue.variable.type.class ¬ atom; <> [] ¬ SymTab.Store[buttons, buttonName, button]; RETURN[button]; }; AddATOMVariable: PUBLIC PROC [button: ActiveButton, varName: ROPE, varVal: ATOM] = { nvPair: NameVariablePair; nullButton: NullButton _ NARROW[button]; <> nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: ATOM]--], value: varVal]] ]; nvPair.variable.type.class ¬ atom; <> nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues]; }; CreateROPEButton: PUBLIC PROC [doc: ActiveDoc, buttonName: ROPE, initialVarVal: ROPE] RETURNS [ActiveButton] = { button: NullButton; buttons: SymTab.Ref _ NARROW[doc.theDoc, NullDoc].buttons; <> button _ NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: rope]--], value: initialVarVal]]]]]; button.firstValue.variable.type.class ¬ rope; <> [] ¬ SymTab.Store[buttons, buttonName, button]; RETURN[button]; }; AddROPEVariable: PUBLIC PROC [button: ActiveButton, varName: ROPE, varVal: ROPE] = { nvPair: NameVariablePair; nullButton: NullButton _ NARROW[button]; <> nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: ROPE]--], value: varVal]] ]; nvPair.variable.type.class ¬ rope; <> nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues]; }; CreateINTButton: PUBLIC PROC [doc: ActiveDoc, buttonName: ROPE, initialVarVal: INT] RETURNS [ActiveButton] = { button: NullButton; buttons: SymTab.Ref _ NARROW[doc.theDoc, NullDoc].buttons; valRef: REF INT _ NEW[INT ¬ initialVarVal]; button _ NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: integer]--], value: valRef]]]]]; button.firstValue.variable.type.class ¬ integer; <> [] ¬ SymTab.Store[buttons, buttonName, button]; RETURN[button]; }; AddINTVariable: PUBLIC PROC [button: ActiveButton, varName: ROPE, varVal: INT] = { nvPair: NameVariablePair; nullButton: NullButton _ NARROW[button]; varValRef: REF INT _ NEW[INT ¬ varVal]; nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: integer]--], value: varValRef]] ]; nvPair.variable.type.class ¬ integer; <> nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues]; }; CreateREALButton: PUBLIC PROC [doc: ActiveDoc, buttonName: ROPE, initialVarVal: REAL] RETURNS [ActiveButton] = { button: NullButton; buttons: SymTab.Ref _ NARROW[doc.theDoc, NullDoc].buttons; valRef: REF REAL _ NEW[REAL ¬ initialVarVal]; button _ NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: real]--], value: valRef]]]]]; button.firstValue.variable.type.class ¬ real; <> [] ¬ SymTab.Store[buttons, buttonName, button]; RETURN[button]; }; AddREALVariable: PUBLIC PROC [button: ActiveButton, varName: ROPE, varVal: REAL] = { nvPair: NameVariablePair; nullButton: NullButton _ NARROW[button]; varValRef: REF REAL _ NEW[REAL ¬ varVal]; nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class: real]--], value: varValRef]] ]; nvPair.variable.type.class ¬ real; <> nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues]; }; <> CreateRopeEnumerationButton: PUBLIC PROC [doc: ActiveDoc, buttonName: ROPE, initialVarVal: ROPE, type: LIST OF ROPE] RETURNS [ActiveButton] = { OPEN List; ptr, anyList: LORA; ptr ¬ anyList ¬ CONS[type.first, NIL]; FOR al: LIST OF ROPE ¬ type.rest, al.rest UNTIL al=NIL DO ptr.rest ¬ CONS[al.first, NIL]; ptr ¬ ptr.rest ENDLOOP; RETURN[CreateEnumeratedButton[doc, buttonName, initialVarVal, anyList]]; }; AddRopeEnumerationVariable: PUBLIC PROC [button: ActiveButton, varName: ROPE, varVal: ROPE, type: LIST OF ROPE] = { OPEN List; ptr, anyList: LORA; ptr ¬ anyList ¬ CONS[type.first, NIL]; FOR al: LIST OF ROPE ¬ type.rest, al.rest UNTIL al=NIL DO ptr.rest ¬ CONS[al.first, NIL]; ptr ¬ ptr.rest ENDLOOP; AddEnumeratedVariable[button, varName, varVal, anyList]; }; <> CreateEnumeratedButton: PUBLIC PROC [doc: ActiveDoc, buttonName: ROPE, initialVarVal: REF, type: LIST OF REF] RETURNS [ActiveButton] = { count: NAT ¬ 0; button: NullButton; buttons: SymTab.Ref _ NARROW[doc.theDoc, NullDoc].buttons; button _ NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[List.Length[type]]-- ¬ [class: enumerated]--], value: initialVarVal]]]]]; button.firstValue.variable.type.class ¬ enumerated; FOR elements: LIST OF REF _ type, elements.rest UNTIL elements = NIL DO button.firstValue.variable.type.enumeration[count] ¬ elements.first; count _ count + 1; ENDLOOP; [] ¬ SymTab.Store[buttons, buttonName, button]; RETURN[button]; }; AddEnumeratedVariable: PUBLIC PROC [button: ActiveButton, varName: ROPE, varVal: REF, type: LIST OF REF] = { count: NAT ¬ 0; nvPair: NameVariablePair; nullButton: NullButton _ NARROW[button]; nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[List.Length[type]]-- ¬ [class:
]--], value: varVal]] ]; nvPair.variable.type.class ¬ enumerated; FOR elements: LIST OF REF _ type, elements.rest UNTIL elements = NIL DO nvPair.variable.type.enumeration[count] ¬ elements.first; count _ count + 1; ENDLOOP; nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues]; }; END. Create
Button: PUBLIC PROC [doc: ActiveDoc, buttonName: ROPE, initialVarVal:
] RETURNS [ActiveButton] = { button: NullButton; buttons: SymTab.Ref _ NARROW[doc.theDoc, NullDoc].buttons; valRef: REF
 _ NEW[
 ¬ initialVarVal]; button _ NEW[NullButtonObj ¬ [name: buttonName, firstValue: [name: "Value", variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class:
]--], value: valRef]]]]]; button.firstValue.variable.type.class ¬
; button.firstValue.variable.type.enumeration ¬
; [] ¬ SymTab.Store[buttons, buttonName, button]; RETURN[button]; }; Add
Variable: PUBLIC PROC [button: ActiveButton, varName: ROPE, varVal:
] = { nvPair: NameVariablePair; nullButton: NullButton _ NARROW[button]; varValRef: REF
 _ NEW[
 ¬ varVal]; nvPair ¬ [name: varName, variable: NEW[VariableObj ¬ [type: NEW[VariableTypeObj[0]-- ¬ [class:
]--], value: varValRef]] ]; nvPair.variable.type.class ¬
; nvPair.variable.type.enumeration ¬
; nullButton.moreValues ¬ CONS[nvPair, nullButton.moreValues]; }; ­­­­­ Enumerated types in Poppy are more general than in Cedar. Any base type can form an enumerated type. For example: x: {3, 7, 15} = 3; -- INT base type x: {"Hello", "Goodbye"} = "Hello"; -- ROPE base type x: {Foo, Bar} = Foo; -- ATOM base type x: {34.2, 63.6, 12.2} = 63.6; -- REAL base type x: {FALSE, TRUE} = FALSE -- BOOL base type (pretty silly)