Produced by Deltopia DeltaWalker on Fri Sep 4 14:23:34 2020. See www.deltawalker.com for information about DeltaWalker.
| File | Path |
|---|---|
| Reference | /Users/milby/Desktop/OOP/compare/brian/stack_OOPEngine_.livecodescript |
| Modified | /Users/milby/Desktop/OOP/compare/mark/stack_OOPEngine_.livecodescript |
| Ignore differences in whitespace | false |
| Ignore differences in character case | false |
| Ignore differences in line endings (CR and LF) | true |
| Show inline differences | false |
| Filter | Description | RegEx | Target |
|---|---|---|---|
| [\n\r\f\x0B]$ | Ignore Line Endings | No | Chars |
There were no active folder filters.
| Description | Blocks | Lines |
|---|---|---|
| Same | 28 | 180 |
| Changed | 19 | 208 |
| Added | 4 | 8 |
| Deleted | 4 | 13 |
1Script "stack_OOPEngine_" 2 3/* 4# Name: stack "OOPEngine" 5# ID: stack "OOPEngine" 6*/ 7 8 9############################### 10# OOP Engine 11 12# original by Håkan Liljegren 2012 13# modified by Mark Wieder 2020 14# modified by Brian Milby 2020 15 16# classes are buttons or stacks, objects are groups by default 17# dispatch has a tristate return value: handled, passed, unhandled 18# added newClass and deleteClass operators 19# added reference count for class deletion 20# added class constructors and destructors | 1Script "stack_OOPEngine_" 2 3/* 4# Name: stack "OOPEngine" 5# ID: stack "OOPEngine" 6*/ 7 8 9############################### 10# OOP Engine 11 12# original by Håkan Liljegren 2012 13# modified by Mark Wieder 2020 14# modified by Brian Milby 2020 15 16# classes are buttons or stacks, objects are groups by default 17# dispatch has a tristate return value: handled, passed, unhandled 18# added newClass and deleteClass operators 19# added reference count for class deletion 20# added class constructors and destructors |
21# there is now a Classes card for classes expected to be in general use 22# local classes are checked first: if no match then the global classes are checked 23# v1.05 fixed newObject to create the class name rather than the object name 24# also changed the invokeConstructorsOf call to dispatch to the object instead of the behavior | |
21############################### 22 23constant kVersion = 1.2.0 24constant kClassStorage = "Classes" | 25############################### 26 27constant kVersion = 1.2.0 28constant kClassStorage = "Classes" |
29--constant kAllowCascadingDeletes = false | |
25local sClassA -- index of class names to button long id | 30local sClassA -- index of class names to button long id |
26local sClassListA -- index of class hierarchy for each class | |
27 28function OOPversion 29 return "OOP Engine version" && kVersion 30end OOPversion 31 32function superClass 33 local tSuperClass 34 35 if the behavior of the target is not empty then 36 put the behavior of the target into tSuperClass 37 end if 38 return tSuperClass 39end superClass 40 41private function classExists? pClassName | 31 32function OOPversion 33 return "OOP Engine version" && kVersion 34end OOPversion 35 36function superClass 37 local tSuperClass 38 39 if the behavior of the target is not empty then 40 put the behavior of the target into tSuperClass 41 end if 42 return tSuperClass 43end superClass 44 45private function classExists? pClassName |
42 return sClassA[pClassName] is not empty | 46 local tClassID 47 48 return classIDFromName(pClassName) is not empty |
43end classExists? 44 45function classIDFromName pClassName 46 local tClassID 47 48 put sClassA[pClassName] into tClassID 49 if tClassID is empty then 50 throw "Class" && pClassName && "not found" 51 end if 52 return tClassID 53end classIDFromName 54 55# Add classes from specified card to class index 56command registerClasses pCard, pUpdateClasses? 57 repeat with tID=1 to the number of buttons of pCard 58 registerClass the long id of button tID of pCard, pUpdateClasses? 59 end repeat 60end registerClasses 61 62# Register a specific class, either a button or a stack 63command registerClass pClassObject, pUpdateClass? 64 local tName, tLongID 65 if not exists(pClassObject) then 66 throw "class object" && pClassObject && "not found" 67 end if 68 put the short name of pClassObject into tName 69 put the long id of pClassObject into tLongID 70 if sClassA[tName] is not empty and pUpdateClass? is not true \ 71 and sClassA[tName] is not tLongID then 72 throw "class" && tName && "already exists in index" 73 end if 74 put tLongID into sClassA[tName] | 49end classExists? 50 51function classIDFromName pClassName 52 local tClassID 53 54 put sClassA[pClassName] into tClassID 55 if tClassID is empty then 56 throw "Class" && pClassName && "not found" 57 end if 58 return tClassID 59end classIDFromName 60 61# Add classes from specified card to class index 62command registerClasses pCard, pUpdateClasses? 63 repeat with tID=1 to the number of buttons of pCard 64 registerClass the long id of button tID of pCard, pUpdateClasses? 65 end repeat 66end registerClasses 67 68# Register a specific class, either a button or a stack 69command registerClass pClassObject, pUpdateClass? 70 local tName, tLongID 71 if not exists(pClassObject) then 72 throw "class object" && pClassObject && "not found" 73 end if 74 put the short name of pClassObject into tName 75 put the long id of pClassObject into tLongID 76 if sClassA[tName] is not empty and pUpdateClass? is not true \ 77 and sClassA[tName] is not tLongID then 78 throw "class" && tName && "already exists in index" 79 end if 80 put tLongID into sClassA[tName] |
75 delete variable sClassListA[tName] | |
76end registerClass 77 | 81end registerClass 82 |
78function newObject pClass, pName, pType, pParams | 83function isAClass? pName 84 return classIDFromName(pName) is not empty 85end isAClass? 86 87--function newClass pClassName, pSuperClass 88-- if classExists?(pClassName) then 89-- throw "class" && pClassName && "already exists" 90-- else 91-- go card kClassStorage 92-- create button pClassName 93-- if pSuperClass is not empty then 94-- set the behavior of control pClassName to the long id of control pSuperClass of card kClassStorage of me 95-- end if 96-- put the long id of button pClassName of card kClassStorage into sClassA[pClassName] 97-- return the id of button pClassName of card kClassStorage of me 98-- end if 99--end newClass 100 101--command deleteClass pClassName 102-- local tSuperClass 103-- local tClassID 104 105-- put classIDFromName(pClassName) into tClassID 106-- if tClassID is not empty then 107-- put the behavior of control pClassName into tSuperClass 108-- # not sure if deleting the superclass is a good idea either 109-- if kAllowCascadingDeletes then 110-- if tSuperClass is not empty then 111-- # if no object is using the superclass then recursively delete the superclass 112-- deleteClass tSuperClass 113-- end if 114-- end if 115-- # finally delete this class 116-- dispatch function "decrementReferenceCount" to tClassID 117-- if the result is 0 then 118-- delete button pClassName of card kClassStorage 119-- delete variable sClassA[pClassName] 120-- else 121-- throw "Class" && pClassName && "is still in use, so can't be deleted" 122-- end if 123-- end if 124--end deleteClass 125 126--function decrementReferenceCountOf pClassID 127-- local tReferenceCount 128 129-- put the referenceCount of pClassID into tReferenceCount 130-- if tReferenceCount > 0 then 131-- subtract 1 from tReferenceCount 132-- set the referenceCount of pClassID to tReferenceCount 133-- end if 134-- return tReferenceCount 135--end decrementReferenceCountOf 136 137--command incrementReferenceCountOf pClassID 138-- local tReferenceCount 139 140-- put the referenceCount of pClassID into tReferenceCount 141-- if tReferenceCount is empty then 142-- put 1 into tReferenceCount 143-- else 144-- add 1 to tReferenceCount 145-- end if 146-- set the referenceCount of pClassID to tReferenceCount 147--end incrementReferenceCountOf 148 149function newObject pClass, pName, pType |
79 local tNewObject, tClassList, tSuperClass | 150 local tNewObject, tClassList, tSuperClass |
80 | 151 |
81 if sClassA[pClass] is not empty then | 152 if sClassA[pClass] is not empty then |
153 -- if tClassID is not empty then 154 # this switch statment exists because we can't say create pType | |
82 switch pType 83 case "stack" | 155 switch pType 156 case "stack" |
84 create stack pName | 157 put newStack(pName) into tNewObject |
85 break 86 case "card" | 158 break 159 case "card" |
87 create card pName | 160 put newCard(pName) into tNewObject 161 break 162 case "background" 163 set the backgroundBehavior of the templategroup to true 164 default 165 case "group" 166 put newGroup(pName) into tNewObject 167 reset the templategroup |
88 break 89 case "button" | 168 break 169 case "button" |
90 create button pName | 170 put newButton(pName) into tNewObject |
91 break 92 case "field" | 171 break 172 case "field" |
93 create field pName | 173 put newField(pName) into tNewObject |
94 break 95 case "image" | 174 break 175 case "image" |
96 create image pName | 176 put newImage(pName) into tNewObject |
97 break 98 case "scrollbar" | 177 break 178 case "scrollbar" |
99 create scrollbar pName | 179 put newScrollbar(pName) into tNewObject |
100 break 101 case "graphic" | 180 break 181 case "graphic" |
102 create graphic pName | 182 put newGraphic(pName) into tNewObject |
103 break 104 case "player" | 183 break 184 case "player" |
105 create player pName | 185 put newPlayer(pName) into tNewObject |
106 break | 186 break |
107 case "background" 108 set the backgroundBehavior of the templategroup to true 109 # fall through 110 case "group" 111 default 112 set the visible of the templategroup to false # Make it "truly" invisible 113 set the margins of the templategroup to 0 # Make it "truly" invisible 114 create group pName 115 reset the templategroup 116 break | |
117 end switch | 187 end switch |
118 put the long id of it into tNewObject | |
119 set the behavior of tNewObject to sClassA[pClass] | 188 set the behavior of tNewObject to sClassA[pClass] |
189 | |
120 # call the class constructors in order | 190 # call the class constructors in order |
121 put _getClassList(pClass) into tClassList 122 repeat for each line tClass in tClassList 123 dispatch tClass to tNewObject with pParams 124 end repeat | 191 invokeConstructorsOf tNewObject, param(4) |
125 return tNewObject 126 else 127 throw "Class " & pClass & ": no such class" 128 end if 129end newObject 130 | 192 return tNewObject 193 else 194 throw "Class " & pClass & ": no such class" 195 end if 196end newObject 197 |
131private function _getClassList pClass 132 local tClassList, tSuperClass 133 put sClassListA[pClass] into tClassList 134 if tClassList is empty then 135 put pClass into tClassList 136 put the behavior of sClassA[pClass] into tSuperClass 137 repeat while tSuperClass is not empty 138 put the short name of tSuperClass & lf before tClassList 139 put the behavior of tSuperClass into tSuperClass 140 end repeat 141 put tClassList into sClassListA[pClass] 142 end if 143 return tClassList 144end _getClassList | 198# Brian's list constructor 199private command invokeConstructorsOf pObject, pParams 200 # get the behavior chain for the constructors 201 local tClass, tClassList 202 put the behavior of pObject into tClass 203 204 repeat while tClass is not empty 205 put tClass & cr before tClassList 206 put the behavior of tClass into tClass 207 end repeat 208 delete the last char of tClassList 209 210 # call the class constructors in order 211 repeat for each line tClass in tClassList 212 dispatch the short name of tClass to pObject with pParams 213 end repeat 214end invokeConstructorsOf 215 216# these all exist because we can't say create <expression> 217 218private function newStack pName 219 create stack pName 220 return the long id of it 221end newStack 222 223private function newCard pName 224 create card pName 225 return the long id of it 226end newCard 227 228private function newGroup pName 229 set the visible of the templategroup to false # Make it "truly" invisible 230 set the margins of the templategroup to 0 # Make it "truly" invisible 231 create group pName 232 return the long id of it 233end newGroup 234 235private function newButton pName 236 create button pName 237 return the long id of it 238end newButton 239 240private function newField pName 241 create field pName 242 return the long id of it 243end newField 244 245private function newImage pName 246 create image pName 247 return the long id of it 248end newImage 249 250private function newScrollbar pName 251 create scrollbar pName 252 return the long id of it 253end newScrollbar 254 255private function newGraphic pName 256 create graphic pName 257 return the long id of it 258end newGraphic 259 260private function newPlayer pName 261 create player pName 262 return the long id of it 263end newPlayer |
145 146# example class constructor 147# the handler names should be the same as the class name | 264 265# example class constructor 266# the handler names should be the same as the class name |
148/* 149command constructor | 267#command constructor |
150 # put the short name of this me && param(0) && the id of the target & cr after msg | 268 # put the short name of this me && param(0) && the id of the target & cr after msg |
151end constructor 152*/ | 269#end constructor |
153 154# example class destructor | 270 271# example class destructor |
155/* 156command destructor 157 local tSuperClass 158 put the behavior of this me into tSuperClass | 272#command destructor 273 #local tSuperClass 274 #put the behavior of this me into tSuperClass |
159 -- 160 # do the local destructor tasks first 161 # put the short name of this me && param(0) && the id of the target & cr after msg 162 -- 163 # then pass up the message chain | 275 -- 276 # do the local destructor tasks first 277 # put the short name of this me && param(0) && the id of the target & cr after msg 278 -- 279 # then pass up the message chain |
164 if tSuperClass is not empty then 165 pass destructor 166 end if 167end destructor 168*/ | 280 #if tSuperClass is not empty then 281 #pass destructor 282 #end if 283#end destructor |
169 170on deleteObject pObject | 284 285on deleteObject pObject |
171 if isObject?(pObject) then | 286 if exists(pObject) then |
172 # call the class destructor if it exists 173 dispatch "destructor" to pObject 174 delete pObject 175 else 176 # Maybe we got just an object name? 177 if exists(control pObject) then | 287 # call the class destructor if it exists 288 dispatch "destructor" to pObject 289 delete pObject 290 else 291 # Maybe we got just an object name? 292 if exists(control pObject) then |
178 deleteObject(the long id of control pObject) | 293 deleteObject(the long id of group pObject) |
179 else 180 throw "Object " & pObject & ": no such object" 181 end if 182 end if 183end deleteObject 184 185function messageObject pObject, pMethod 186 local tParams 187 local tCommand 188 189 put empty into tParams 190 repeat with i = 3 to the paramCount 191 put param(i) & comma & space after tParams 192 end repeat 193 delete last char of tParams 194 195 dispatch function pMethod to pObject with tParams 196 if it is not "unhandled" then 197 return the result 198 else 199 # Try command instead of function 200 dispatch pMethod to pObject with tParams 201 if it is not "unhandled" then 202 return the result 203 else 204 throw "Object error: No method " & pMethod & " in class " & classNameOf(pObject) 205 end if 206 end if 207end messageObject 208 209--> introspection 210 211function isObject? pObject 212 if exists(pObject) and exists(the behavior of pObject) then 213 if sClassA[the short name of the behavior of pObject] is not empty then 214 return true 215 end if 216 end if 217 return false 218end isObject? 219 220function ClassNameOf pObject 221 if isObject?(pObject) then 222 return the short name of the behavior of pObject 223 else 224 return empty 225 end if 226end ClassNameOf 227 228function isObjectOfClass? pObject, pClass 229 if ClassNameOf(pObject) is pClass then 230 return true 231 else 232 return false 233 end if 234end isObjectOfClass? 235 236# OOP-engine 237############################################ | 294 else 295 throw "Object " & pObject & ": no such object" 296 end if 297 end if 298end deleteObject 299 300function messageObject pObject, pMethod 301 local tParams 302 local tCommand 303 304 put empty into tParams 305 repeat with i = 3 to the paramCount 306 put param(i) & comma & space after tParams 307 end repeat 308 delete last char of tParams 309 310 dispatch function pMethod to pObject with tParams 311 if it is not "unhandled" then 312 return the result 313 else 314 # Try command instead of function 315 dispatch pMethod to pObject with tParams 316 if it is not "unhandled" then 317 return the result 318 else 319 throw "Object error: No method " & pMethod & " in class " & classNameOf(pObject) 320 end if 321 end if 322end messageObject 323 324--> introspection 325 326function isObject? pObject 327 if exists(pObject) and exists(the behavior of pObject) then 328 if sClassA[the short name of the behavior of pObject] is not empty then 329 return true 330 end if 331 end if 332 return false 333end isObject? 334 335function ClassNameOf pObject 336 if isObject?(pObject) then 337 return the short name of the behavior of pObject 338 else 339 return empty 340 end if 341end ClassNameOf 342 343function isObjectOfClass? pObject, pClass 344 if ClassNameOf(pObject) is pClass then 345 return true 346 else 347 return false 348 end if 349end isObjectOfClass? 350 351# OOP-engine 352############################################ |