added sample GUI module with UIP

[k8lst.git] / modules / guiModules / gui.st

Package [
  GUI
]


class: GuiWidget [
  | id ablock |
]


class: GuiSingleton  | widgetlist quitflag | [
  ^idToString: elid [
    <#IUPDispatcher 250 elid>.
    ^nil
  ]

  ^message: msg title: title [
    <#IUPDispatcher 1 title msg>
  ]

  ^message: msg  [
    ^self message: msg title: 'LittleSmalltalk Message'
  ]

  ^canvas: action [
    <#IUPDispatcher 2 0 action>.
    self primitiveFailed
  ]

  ^button: label action: action [
    <#IUPDispatcher 2 1 action label>.
    self primitiveFailed
  ]

  ^toggle: label action: action [
    <#IUPDispatcher 2 2 action label>.
    self primitiveFailed
  ]

  ^edit: action [
    <#IUPDispatcher 2 3 action>.
    self primitiveFailed
  ]

  ^multiEdit: action [
    <#IUPDispatcher 2 4 action>.
    self primitiveFailed
  ]

  ^list: action [
    <#IUPDispatcher 2 5 action>.
    self primitiveFailed
  ]

  ^label: label [
    <#IUPDispatcher 2 6 label>.
    self primitiveFailed
  ]

  ^progressBar [
    <#IUPDispatcher 2 7>.
    self primitiveFailed
  ]

  ^spin [
    <#IUPDispatcher 2 8>.
    self primitiveFailed
  ]

  ^tree [
    <#IUPDispatcher 2 9>.
    self primitiveFailed
  ]

  ^frame: elid [
    <#IUPDispatcher 2 10 elid>.
    self primitiveFailed
  ]

  ^dialog: elid [
    <#IUPDispatcher 2 11 elid>.
    self primitiveFailed
  ]

  ^fill [
    <#IUPDispatcher 3 0>.
    self primitiveFailed
  ]

  ^hbox [
    <#IUPDispatcher 3 1>.
    self primitiveFailed
  ]

  ^vbox [
    <#IUPDispatcher 3 2>.
    self primitiveFailed
  ]

  ^zbox [
    <#IUPDispatcher 3 3>.
    self primitiveFailed
  ]

  ^radiobox: elid [
    <#IUPDispatcher 3 4 elid>.
    self primitiveFailed
  ]

  ^cbox [
    <#IUPDispatcher 3 5>.
    self primitiveFailed
  ]

  ^sbox [
    <#IUPDispatcher 3 6>.
    self primitiveFailed
  ]

  ^normalizer [
    <#IUPDispatcher 3 7>.
    self primitiveFailed
  ]

  ^split: elid0 and: elid1 [
    <#IUPDispatcher 3 8 elid0 elid1>.
    self primitiveFailed
  ]

  ^split [
    <#IUPDispatcher 3 8>.
    self primitiveFailed
  ]

  ^attachTo: boxid element: elid [
    <#IUPDispatcher 4 boxid elid>.
    self primitiveFailed
  ]

  ^detach: elid [
    <#IUPDispatcher 5 elid>.
    self primitiveFailed
  ]

  ^destroy: elid [
    <#IUPDispatcher 6 elid>.
    self primitiveFailed
  ]

  ^show: elid [
    <#IUPDispatcher 7 elid>.
    self primitiveFailed
  ]

  ^registerEvent: aName [
    <#IUPDispatcher 8 aName>.
    self primitiveFailed
  ]

  ^unregisterEvent: aName [
    <#IUPDispatcher 8 aName false>.
    self primitiveFailed
  ]

  ^registerListEvent: aName [
    <#IUPDispatcher 9 aName>.
    self primitiveFailed
  ]

  ^unregisterListEvent: aName [
    <#IUPDispatcher 9 aName false>.
    self primitiveFailed
  ]

  ^getEvent [
    <#IUPDispatcher 10>.
    self primitiveFailed
  ]

  ^setAttribute: elid name: aName value: value [
    <#IUPDispatcher 11 elid aName value>.
    self primitiveFailed
  ]

  ^getAttribute: elid name: aName [
    <#IUPDispatcher 12 elid aName>.
    self primitiveFailed
  ]

  ^deleteAttribute: elid name: aName [
    <#IUPDispatcher 13 elid aName>.
    self primitiveFailed
  ]

  ^popup: elid [
    <#IUPDispatcher 14 elid>.
    self primitiveFailed
  ]

  ^show: elid [
    <#IUPDispatcher 15 elid>.
    self primitiveFailed
  ]

  ^hide: elid [
    <#IUPDispatcher 15 elid true>.
    self primitiveFailed
  ]

  ^addWidget: aWC [
    widgetlist ifNil: [ widgetlist := List new ].
    widgetlist << aWC.
  ]

  ^removeWidget: aWC [
    widgetlist ifNotNil: [ widgetlist remove: aWC ifAbsent: [ nil ]]
  ]

  ^findWidgetById: aId [
    widgetlist ifNotNil: [ widgetlist do: [:w | w idToString = aId ifTrue: [ ^w ]]].
    ^nil
  ]

  ^setQuitFlag [
    quitflag := true.
  ]

  ^passEvent: aId [
    widgetlist ifNotNil: [ widgetlist do: [:w | (w passEvent: aId) ifTrue: [ ^true ]]].
    ^false
  ]

  ^mainLoop [
    quitflag := false.
    [ quitflag ] whileFalse: [
      System eventWaitFor: 1100.
      self passEvent: (self getEvent).
    ].
  ]
]


GuiWidget extend [
  ^new [
    self error: 'GuiWidget instances must be created with special methods'.
  ]

  ^newWithId: aId [
    | obj |
    obj := self basicNew.
    self in: obj at: 1 put: aId.
    ^obj
  ]

  idToString [
    ^GuiSingleton idToString: id
  ]

  id [
    ^id
  ]

  setAttribute: aName value: value [
    GuiSingleton setAttribute: id name: aName value: value
  ]

  attribute: aName [
    ^GuiSingleton getAttribute: id name: aName
  ]

  removeAttribute: aName [
    GuiSingleton deleteAttribute: id name: aName
  ]

  popup [
    GuiSingleton popup: id
  ]

  show [
    GuiSingleton show: id
  ]

  passEvent: aId [
    "returns true if event handler found"
    self idToString = aId ifTrue: [ self onEvent. ^true ].
    ^false
  ]

  detach [
    GuiSingleton detach: id
  ]

  attachTo: aWid [
    GuiSingleton attachTo: aWid id element: id
  ]
]


GuiWidget subclass: GuiButton [
  ^new: aText actionBlock: aBlock [
    | obj |
    obj := self newWithId: (GuiSingleton button: aText action: true).
    self in: obj var: #ablock put: aBlock.
    ^obj
  ]

  onEvent [
    ablock ifNotNil: [ ablock value ].
  ]
]


GuiWidget subclass: GuiRestrictedGroup [
  | widgetlist |

  containsWidget: aWC [
    widgetlist ifNotNil: [ ^widgetlist includes: aWC ].
    ^false
  ]

  findWidgetById: aId [
    widgetlist ifNotNil: [ widgetlist do: [:w | w idToString = aId ifTrue: [ ^w ]]].
    ^nil
  ]

  passEvent: aId [
    "returns true if event handler found"
    | w |
    (super passEvent: aId) ifTrue: [ ^true ].
    (w := self findWidgetById: aId) ifNotNil: [ w onEvent. ^true ].
    widgetlist ifNotNil: [ widgetlist do: [:w | (w passEvent: aId) ifTrue: [ ^true ]]].
    ^false
  ]
]


GuiRestrictedGroup subclass: GuiGroup [
  addWidget: aWC [
    widgetlist ifNil: [ widgetlist := List new ].
    widgetlist << aWC.
  ]

  removeWidget: aWC [
    widgetlist ifNotNil: [ widgetlist remove: aWC ifAbsent: [ nil ]]
  ]
]


GuiGroup subclass: GuiBox [
  addWidget: aWid [
    aWid; detach; attachTo: self.
    ^super addWidget: aWid
  ]

  removeWidget: aWid [
    (self containsWidget: aWid) ifTrue: [
      aWid detach.
      super removeWidget: aWid.
    ]
  ]
]

GuiBox subclass: GuiHBox [
  ^new [
    ^self newWithId: (GuiSingleton hbox).
  ]
]

GuiBox subclass: GuiVBox [
  ^new [
    ^self newWithId: (GuiSingleton vbox).
  ]
]

GuiBox subclass: GuiCBox [
  ^new [
    ^self newWithId: (GuiSingleton cbox).
  ]
]

GuiBox subclass: GuiSBox [
  ^new [
    ^self newWithId: (GuiSingleton sbox).
  ]
]

GuiBox subclass: GuiNormBox [
  ^new [
    ^self newWithId: (GuiSingleton normalizer).
  ]
]


GuiRestrictedGroup subclass: GuiSplit [
  ^new: aWid0 and: aWid1 [
    | obj |
    obj := self newWithId: (GuiSingleton split: aWid0 and aWid1).
    self in: obj var: #widgetlist put: (List with: aWid0 with: aWid1).
    ^obj
  ]

  left [
    ^widgetlist first
  ]

  right [
    ^widgetlist at: 1
  ]
]



GuiRestrictedGroup subclass: GuiDialog [
  ^new: aTitle widget: aWidget [
    | obj |
    obj := self newWithId: (GuiSingleton dialog: aWidget id).
    self in: obj var: #widgetlist put: (List with: aWidget).
    obj setAttribute: 'TITLE' value: aTitle asString.
    ^obj
  ]

  mainWidget [
    ^widgetlist first
  ]
]