TextCollectorView subclass: #CLIView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! CLIView comment: 'A Command Line Interpreter is a mechanism that get some code from the user (a line ends with CR), executes that code and writes a result in the CLI-Window. '! !CLIView methodsFor: 'controller access'! defaultControllerClass "new Controller" ^CLIController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CLIView class instanceVariableNames: ''! !CLIView class methodsFor: 'instance creation'! open: aCLI label: aString "Answer an instance of me on the argument, aCLI. The label of the StandardSystemView should be aString." | topView aView myController | topView _ StandardSystemView new. topView model: aCLI. topView label: aString. topView minimumSize: 160 @ 55. aView _ self new model: aCLI. aView insideColor: Form white. aView borderWidth: 1. topView borderWidth: 1. topView addSubView: aView. topView icon: (Icon constantNamed: #default). myController _ topView controller. aCLI myController: myController. myController open! ! TextCollectorController subclass: #TracerController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! TracerController comment: 'This class is a normal controller for the SCF Tracer with a new close method. When is choosen, the tracer and its mechanisms were erased, the single stepper is switched off and so on.'! !TracerController methodsFor: 'menu messages'! close "new close" CFInterpreter sleep: 0. CFInterpreter singleStepOff. super close! ! View subclass: #PictureView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! PictureView comment: 'This class shows a picture'! !PictureView methodsFor: 'updating'! update: aParameter "simply redisplay all" self displayView! ! !PictureView methodsFor: 'displaying'! displayView "displays the picture" | box pos | box _ self insetDisplayBox. pos _ box origin. self model form displayAt: pos! ! !PictureView methodsFor: 'controller access'! defaultControllerClass "returns the correct controller" ^PictureController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! PictureView class instanceVariableNames: ''! !PictureView class methodsFor: 'instance creation'! open: aModel "Open a view for a form" | aPicView topView size someController | size _ aModel size + 4. topView _ StandardSystemView new label: 'Picture'. topView minimumSize: size. topView maximumSize: size. topView borderWidth: 2. aPicView _ PictureView new model: aModel. aPicView borderWidth: 0. aPicView insideColor: Form white. topView addSubView: aPicView. someController _ topView controller. aModel myController: someController. someController open! ! TextCollectorController subclass: #CLIController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! CLIController comment: 'TextCollectorController with new readKeyboard'! !CLIController methodsFor: 'control defaults'! readKeyboard "overwritten readKeyboard from ParagraphEditor. Does the new stuff" | typeAhead currentCharacter| self deselect. typeAhead _ WriteStream on: (String new: 128). beginTypeInBlock == nil ifTrue: [UndoSelection _ self selection. beginTypeInBlock _ startBlock copy]. [sensor keyboardPressed] whileTrue: [CurrentEvent _ sensor keyboardEvent. currentCharacter _ CurrentEvent keyCharacter. self model addChar: currentCharacter. (self perform: (Keyboard at: currentCharacter asciiValue + 1) with: typeAhead with: currentCharacter) ifTrue: [^self]]. self replaceSelectionWith: (Text string: typeAhead contents emphasis: emphasisHere). startBlock _ stopBlock copy. self selectAndScroll! ! !CLIController methodsFor: 'menu messages'! accept "comment stating purpose of message" [self model execLine: (self selectionAsStream)] fork! cancel "clears the cli" self model clear! ! Model subclass: #Slider instanceVariableNames: 'value ' classVariableNames: '' poolDictionaries: '' category: 'SCF'! Slider comment: 'a slider is a 1-dimensional input. value range: 0..25'! !Slider methodsFor: 'initialize'! initialize "initialize the value" value _ 0! ! !Slider methodsFor: 'accessing'! dec "decrement value" (value > 0) ifTrue: [ value _ value - 1]. CFInterpreter sleep: value * 500. self changed! inc "increment value" (value < 25) ifTrue: [ value _ value + 1]. CFInterpreter sleep: value * 500. self changed! initValue: aNumber "initialize value" ((aNumber < 101) & (aNumber > -1)) ifTrue: [ value _ aNumber // 4]! value "reports value" ^value! value: aNumber "sets value" ((aNumber < 101) & (aNumber > -1)) ifTrue: [ value _ aNumber // 4]. self changed! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Slider class instanceVariableNames: ''! !Slider class methodsFor: 'instance creation'! new "new new" ^super new initialize! ! StringHolderController subclass: #HyperTextController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! HyperTextController comment: 'This class is the hypertext controller. This version executes only CFInterpreter commands, but it can easily modified for own purposes'! !HyperTextController methodsFor: 'menu messages'! accept "follows a hypertext link" | aCFInterpreter anString aStream | aCFInterpreter _ CFInterpreter new. anString _ self selectionAsStream upTo: $<. aStream _ ReadStream on: (self model dictionary at: anString). aCFInterpreter interpret: aStream! ! Controller subclass: #PictureController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! PictureController comment: 'This class provides the possibility of a key, mouse and menuhandler'! !PictureController methodsFor: 'control defaults'! controlActivity self processEvents! isControlActive ^super isControlActive & sensor blueButtonPressed not! ! !PictureController methodsFor: 'sensor access'! processEvents "Computes keys and yellow mouse button" (sensor keyboardPressed) ifTrue: [self readKeyboard]. (sensor yellowButtonPressed) ifTrue: [self model popMenu]. (sensor redButtonPressed) ifTrue: [self model mouseKlick: sensor mousePoint - (self view insetDisplayBox origin)]! ! !PictureController methodsFor: 'editing'! readKeyboard | typeAhead currentCharacter currentEvent | currentEvent _ sensor keyboardEvent. currentCharacter _ currentEvent keyCharacter. self model handleKey: currentCharacter! ! OrderedCollection variableSubclass: #Lifo instanceVariableNames: '' classVariableNames: 'ATracer ' poolDictionaries: '' category: 'SCF'! Lifo comment: 'This class provides the SCF-Errorsystem and some TRACER-stuff '! !Lifo methodsFor: 'accessing'! add: anElement "Push on stack" super add: anElement! removeLast "pop from stack" (self size > 0) ifTrue: [^super removeLast] ifFalse: [CFInterpreter error]! ! !Lifo methodsFor: 'displaying'! addStack: anElement "shows the stack" | helpStream | helpStream _ WriteStream on: String new. anElement storeOn: helpStream. helpStream nextPut: $ . ATracer addStack: helpStream contents! showStack "shows the stack" | helpStream | helpStream _ WriteStream on: String new. self do: [:i|i storeOn: helpStream. helpStream nextPut: $ ]. ATracer showStack: helpStream contents! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Lifo class instanceVariableNames: ''! !Lifo class methodsFor: 'accessing'! tracer: aTracer "sets the tracer" ATracer _ aTracer! ! TextCollectorView subclass: #TracerView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! TracerView comment: 'Yet another MVC View'! !TracerView methodsFor: 'controller access'! defaultControllerClass "points to new controller" ^TracerController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TracerView class instanceVariableNames: ''! !TracerView class methodsFor: 'instance creation'! openTracer: aTracer "opens a TracerView" | topView aView aView2 aView3 stepper stepperView onSwitch onSwitchView aCon | topView _ StandardSystemView new. topView label: 'Tracer'. topView minimumSize: 300 @ 225. topView borderWidth: 1. topView model: aTracer. aView _ TextCollectorView new model: (aTracer stack). aView insideColor: Form white. aView2 _ TextCollectorView new model: (aTracer command). aView2 insideColor: Form white. aView3 _ self new model: aTracer. aView3 insideColor: Form white. stepper _ Button newOff. stepper onAction: [CFInterpreter singleStep]. stepperView _ SwitchView new model: stepper. stepperView label: 'singleStep' asDisplayText. stepperView insideColor: Form white. onSwitch _ Switch newOff. onSwitch onAction: [CFInterpreter singleStepOn]. onSwitch offAction: [CFInterpreter singleStepOff]. onSwitchView _ SwitchView new model: onSwitch. onSwitchView label: 'step on/off' asDisplayText. onSwitchView insideColor: Form white. topView addSubView: aView in: (0@0 extent: 1@0.3) borderWidth: 1. topView addSubView: aView2 in: (0@0.3 extent: 1@0.4) borderWidth: 1. topView addSubView: (SliderView on: Slider new) in: (0.0@0.9 extent: 0.6@0.1) borderWidth: 0. topView addSubView: stepperView in: (0.6@0.7 extent: 0.4@0.2) borderWidth: 1. topView addSubView: onSwitchView in: (0.6@0.9 extent: 0.4@0.1) borderWidth: 1. topView addSubView: aView3 in: (0@0.7 extent: 0.6@0.2) borderWidth: 1. topView icon: (Icon constantNamed: #default). aCon _ topView controller. aTracer acontroller: aCon. aCon open! ! TextCollector subclass: #Tracer instanceVariableNames: 'level source slider stack command acontroller ' classVariableNames: '' poolDictionaries: '' category: 'SCF'! Tracer comment: 'This class is the model for the SCF-Tracer'! !Tracer methodsFor: 'initialize'! initialize "sets the level" super initialize. level _ 0. source _ 'NOCODE'. slider _ Slider new. stack _ TextCollector new. command _ TextCollector new! ! !Tracer methodsFor: 'accessing'! acontroller: aController "comment stating purpose of message" acontroller _ aController! close "closes the tracer window" acontroller close. acontroller controlTerminate! command "returns command" ^command! enterLevel "increments level" level _ level + 1. self clear. self show: 'level: ',level printString; cr! exitLevel "decrements level" level _ level - 1. self clear. self show: 'level: ',level printString; cr! level "returns level" ^level! source "returns source" ^source! stack "returns stack" ^stack! ! !Tracer methodsFor: 'displaying'! addStack: aString "adds to stack" stack show: aString! showCommand: aString "shows the command in the window" | spaces | spaces _ String new: level withAll: $ . command show: spaces,'execute ',aString; cr! showData: aString "shows the command in the window" | spaces | spaces _ String new: level withAll: $ . command show: spaces,aString,' on stack'; cr! showStack: aString "shows the stack" stack clear. stack show: aString! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tracer class instanceVariableNames: ''! !Tracer class methodsFor: 'instance creation'! new "new new" ^super new initialize! ! TextCollector subclass: #CLI instanceVariableNames: 'line shell aThing myController ' classVariableNames: '' poolDictionaries: '' category: 'SCF'! CLI comment: 'I''m a TextCollector with a variable containing the last line, holding a block that is executed after typing cr'! !CLI methodsFor: 'initialize'! initialize "intialize the instance variables" super initialize. shell _ nil. line _ ''! ! !CLI methodsFor: 'accessing'! addChar: aChar "adds a Char to line, executes shell if needed" | aNumber | aNumber _ aChar asciiValue. ((aNumber = 8) | (aNumber = 127)) ifTrue: [(line size > 0) ifTrue: [line _ line copyFrom: 1 to: line size - 1]] ifFalse: [line _ line copyWith: aChar. (aChar = Character cr) ifTrue: [(shell notNil) ifTrue: [shell value: line value: aThing]. line _ '']]! close "closes the cli window" myController close. myController controlTerminate! controlTerminate "tricky dummy needed by CFInterpreter"! execLine: aStream "executes one line (used by CLIController)" (shell notNil) ifTrue: [shell value: aStream contents value: aThing]! myController: aController "sets the instance variable" myController _ aController! shell: aBlock "sets shell to a block. Block has two parameters: 1) the string with line 2) the CLI instance e.g.: [:line :cli | cli show: line,'ok' ; cr]" shell _ aBlock! thing: anObject "an Object is used by addChar" aThing _ anObject! view "returns the controllers view" ^myController view! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CLI class instanceVariableNames: ''! !CLI class methodsFor: 'instance creation'! new "new new" ^super new initialize! ! StringHolderView subclass: #HyperTextView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! HyperTextView comment: 'This class shows a hypertext. This version only works with SCF due to the "CFInterpreter addController: myController" commands. Without this line this class is usefull for other programs'! !HyperTextView methodsFor: 'controller access'! defaultControllerClass "returns the correct controller" ^HyperTextController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! HyperTextView class instanceVariableNames: ''! !HyperTextView class methodsFor: 'instance creation'! open: aText "opens a hypertext window" | aHyperText aStringHolderView topView myController | aHyperText _ HyperText new. aHyperText compile: aText withCRs. aStringHolderView _ self container: aHyperText. topView _ StandardSystemView new. topView borderWidth: 1. topView model: aStringHolderView model. topView addSubView: aStringHolderView. topView label: 'Hypertext'. topView minimumSize: 200 @ 150. topView icon: (Icon constantNamed: #default). myController _ topView controller. CFInterpreter addController: myController. myController open! ! Model subclass: #CFInterpreter instanceVariableNames: 'dictionary ' classVariableNames: 'ATracer Cli ConDic CurPath EC1 EC2 Errors Library LibStack Sleep Stack Step SysLib TopPath ' poolDictionaries: '' category: 'SCF'! CFInterpreter comment: 'An instance of this class interprets a stream. Only one interpretersystem allowed (i.e. ONE stack etc). Project started: 1.10.90 Programmers: Fritz Hohl, Ioannis Pindonis e-mail: hohl@az3.informatik.uni-stuttgart.de System: Atari ST + Smalltalk 80 V2.3 Last Change: 6.7.91 Dokumentation level: 8.7.91 Start with: Explanation of variables: a) instance variables dictionary: the dictionary holding local variables b) class variables aTracer: This holds the SCF Tracer, which exists all the time even if you cant see it cli: This holds the CommandLineInterpreter if it exists ConDic: This dictionary holds the controllers (or things which behaves like one) of the windows opened by SCF-Commands CurPath, TopPath: the SCF offset paths. Users cant access the filesystem before this paths EC1, EC2: blocks which handle some possible errors Errors: level of the occured errors Library: current Library (TOS of LibStack) LibStack: the Stack which holds the libraries SysLib: the ''root'' library Sleep: the Delay used by the Tracer Stack: the main Stack'! !CFInterpreter methodsFor: 'initialize'! initialize "intializes the interpreters local dictionary" dictionary _ Dictionary new! ! !CFInterpreter methodsFor: 'logic'! and "logical b1 AND b2 b1 b2 -- b3" | b1 b2 | b1 _ Stack removeLast. b2 _ Stack removeLast. (b1 ~= 0) ifTrue: [(b2 ~= 0) ifTrue: [Stack add: 1] ifFalse: [Stack add: 0]] ifFalse: [Stack add: 0]! eq "checks if the two numbers are equal e1 e2 -- b" self logicop: '='! false "puts FALSE on stack -- b" Stack add: 0! ge "checks if n1 is greater or equal n2 n1 n2 -- b" self logicop: '>='! gt "checks if n1 is greater than n2 n1 n2 -- b" self logicop: '>'! le "checks if n1 is less or equal n2 n1 n2 -- b" self logicop: '<='! logicop: aString "provides logic binary operations on stackelements internal use only" | a b c | a _ Stack removeLast. b _ Stack removeLast. c _ b perform: aString asSymbol with: a. (c = true) ifTrue: [Stack add: 1] ifFalse: [Stack add: 0]! lt "checks if n1 is less than n2 n1 n2 -- b" self logicop: '<'! ne "checks if the two numbers are different e1 e2 -- b" self logicop: '~='! not "logical NOT b1 b1 -- b2" (Stack removeLast ~= 0) ifTrue: [Stack add: 0] ifFalse: [Stack add: 1]! or "logical b1 OR b2 b1 b2 -- b3" | b1 b2 | b1 _ Stack removeLast. b2 _ Stack removeLast. (b1 ~= 0) ifTrue: [Stack add: 1] ifFalse: [(b2 ~= 0) ifTrue: [Stack add: 1] ifFalse: [Stack add: 0]]! true "puts TRUE on stack -- b" Stack add: 1! veq "tests if two words have the same content w1 w2 -- b" | a b c | a _ self pop. b _ self pop. c _ b perform: '=' asSymbol with: a. (c = true) ifTrue: [Stack add: 1] ifFalse: [Stack add: 0]! ! !CFInterpreter methodsFor: 'stack access'! abort "clears the stack e1..en --" Stack _ Lifo new: 100! copy "like pick, but it COPIES the ith element i -- " | help1 | help1 _ Stack size. Stack add: (Stack at: help1 - Stack removeLast)! drop "removes the first stack element e --" Stack removeLast! dup "duplicates the first stack element e -- e e" Stack add: (Stack last)! dup2 "duplicates the first two stack elements e1 e2 -- e1 e2 e1 e2" | a b | b _ Stack removeLast. a _ Stack last. Stack add: b. Stack add: a. Stack add: b! kick "kick the first number of the stack on Transcript internal use only" | aStream | aStream _ WriteStream on: String new. Stack removeLast storeOn: aStream. Transcript show: aStream contents; cr! ncopy "duplicates the first n elements e1..ei i -- e1..ei e1..ei" | distance times | distance _ Stack removeLast. times _ distance. distance _ Stack size - distance + 1. [(times ~= 0)] whileTrue: [Stack add: (Stack at: distance). times _ times - 1. distance _ distance + 1]! pick "picks the ith element on top i -- " | help1 index | index _ 0. help1 _ Stack size - Stack last. self copy. Stack _ Stack reject: [:dummy|index _ index + 1. index = help1]! pop "getContent+removeLast private" self getContent. ^Stack removeLast! rot "puts the third element on top e1 e2 e3 -- e2 e3 e1" | help1 help2 | help1 _ Stack size. help2 _ Stack at: help1 - 2. Stack at: help1 - 2 put: (Stack at: help1 - 1). Stack at: help1 -1 put: (Stack at: help1). Stack at: help1 put: help2! showStack "shows the stack in the Transcript" | helpStream| "helpStream _ WriteStream on: String new. Stack do: [:i|i storeOn: helpStream. helpStream nextPut: $ ]. Transcript show: helpStream contents;cr" Stack do: [:i|Transcript show: i printString,' ']. Transcript cr! showStackView "shows the stack in the stackview" Stack showStack! swap "swaps the first two elements e1 e2 -- e2 e1" | help1 help2 | help2 _ Stack removeLast. help1 _ Stack removeLast. Stack add: help2. Stack add: help1! ! !CFInterpreter methodsFor: 'arithmetic'! abs "absolute value of number n -- i" | anObject | anObject _ Stack removeLast. Stack add: (anObject perform: 'abs' asSymbol)! add "adds two numbers n1 n2 -- " self binop: '+'! cardinalToString "converts a cardinal in a string c -- " Stack add: Stack removeLast printString! dec "decrements c on stack c -- " Stack add: Stack removeLast - 1! div "divides two numbers (integerdivision) n1 n2 -- " self binop: '//'! exp "n1 raised to n2 n1 n2 -- " self binop: 'raisedTo:'! inc "increments c on stack c -- " Stack add: Stack removeLast + 1! integerToString "converts a integer in a string n -- " Stack add: Stack removeLast printString! mod "remainder of an integerdivision n1 n2 -- " self binop: '\\'! mul "multiplicates two numbers n1 n2 -- " self binop: '*'! neg "negates number n1 -- n2" | anObject | anObject _ Stack removeLast. Stack add: (anObject perform: 'negated' asSymbol)! randNum "generates a random number between (including) n1 and n2 n1 n2 -- n3" | rand start end | rand _ Random new. end _ Stack removeLast + 1. start _ Stack removeLast. Stack add: ((rand next * (end - start)) truncated + start)! sub "subtracts two numbers n1 n2 -- " self binop: '-'! ! !CFInterpreter methodsFor: 'words'! badd "adds the B-operator" | value | value _ Stack removeLast. Stack add: 'B',value! bcut "cuts the B-operator" | value | value _ Stack removeLast. (value first = $B) ifTrue: [Stack add: (value copyFrom: 2 to: value size)]! cat "concatenates two words w1 w2 u --" | word1 word2 word3 | word3 _ Stack removeLast. word2 _ self pop. word1 _ self pop. Library at: word3 put: word1,word2! compileAsCode "compile w as a piece of code u w --" | aName aValue | aValue _ self pop. aName _ Stack removeLast. Library at: aName put: aValue. Library at: (aName copyFrom: 2 to: aName size) put: #code! compileAsVariable "compile u as a variable which its value, e as result u e --" | aName aValue | aValue _ Stack removeLast. aName _ Stack removeLast. Library at: aName put: aValue printString. Library at: (aName copyFrom: 2 to: aName size) put: #variable! copyWord "copies word1 to u beginning at i1 with length i2 w i1 i2 u --" | wort1 wort2 start length | wort2 _ Stack removeLast. length _ Stack removeLast - 1. start _ Stack removeLast. wort1 _ self pop. Library at: wort2 put: (wort1 copyFrom: start to: start + length)! def "defines a word with as content and u as name u w --" | value | value _ self pop. Library at: Stack removeLast put: value! fill "defines a word with i bytes of l as content and u as name u i l --" | value times | value _ Stack removeLast. times _ Stack removeLast. Library at: Stack removeLast put: (String new: times withAll: (Character value: value))! getContent "replaces a wordname by its contents" (Stack last isMemberOf: String) ifTrue: [(Stack last first = $#) ifTrue: [Stack add: (self find: Stack removeLast)] ifFalse: [((Stack last) first = $B) ifTrue: [self bcut]]] ifFalse: [Stack add: (self find: Stack removeLast)]! peek "peeks the ith byte of w w i -- l" | wort position | position _ Stack removeLast. wort _ self pop. Stack add: (wort at: position) asciiValue! poke "pokes l in the ith byte of w w i l --" | wort position wert | wert _ Stack removeLast. position _ Stack removeLast. wort _ self pop. wort at: position put: (Character value: wert)! realcopy "make a NEW word out of the old one w1 u -" Library at: Stack removeLast put: self pop deepCopy! rmCompiledWord "removes a compiled word u --" | aName | aName _ Stack removeLast. Library removeKey: aName. Library removeKey: (aName copyFrom: 2 to: aName size)! rmWord "removes a word w --" Library removeKey: Stack removeLast! search "searches w1 in w2, i is the resulting index, starting at 1, 0 means failure w1 w2 -- i" | word1 word2 index | word2 _ self pop. word1 _ self pop. index _ word2 indexOfSubCollection: word1 startingAt: 1. Stack add: index! showDic "shows the dictionary in Transcript" | aStream | aStream _ WriteStream on: String new. Library printOn: aStream. Transcript show: aStream contents; cr! size "puts the size of a word on stack w -- c" Stack add: self pop size! ! !CFInterpreter methodsFor: 'command set'! allReset "resets the SCF-System --" CFInterpreter initializeSeparately. self initialize! binop: aString "performs a binary operation" | anObject aParameter | aParameter _ Stack removeLast. anObject _ Stack removeLast. Stack add: (anObject perform: aString asSymbol with: aParameter)! traceOff "stops tracing" ATracer close! traceOn "starts to trace the interpreter" [TracerView openTracer: ATracer] fork! wait "wait some time" Smalltalk garbageCollect! ! !CFInterpreter methodsFor: 'interpret'! interpret: aPositionableStream "interprets aPositionableStream" | anElement aStream | ATracer enterLevel. aStream _ self noCr: aPositionableStream. [aStream atEnd] whileFalse: [ anElement _ aStream upTo: $ . (anElement = '[') ifTrue: [self lambda: aStream] ifFalse: [(anElement = '"') ifTrue: [aStream upTo: $". aStream skip: 1] ifFalse: [(anElement = '') ifFalse: [self interpretOne: anElement]]]. (Sleep notNil) ifTrue: [Sleep wait]. Processor yield. Step wait]. ATracer exitLevel! interpretOne: aString "interprets one element, either a command or a number" (aString first = $#) ifTrue: [ATracer showData: aString. Stack add: aString] ifFalse: [((aString findString: 'r' startingAt: 1) ~= 0) ifTrue: [ATracer showCommand: aString. self perform: aString asSymbol] ifFalse: [(aString asNumber = 0) ifTrue: [ (aString = '0') ifTrue: [ATracer showData: aString. Stack add: 0] ifFalse: [ATracer showCommand: aString. (self isCompiled: aString) ifTrue: [self execute: aString] ifFalse: [self perform: aString asSymbol]] ] ifFalse: [ATracer showData: aString. Stack add: aString asNumber ] ] ]. Stack showStack! lambda: aPositionableStream "filters blocks" | leftb outStream char outString | outStream _ WriteStream on: String new. outStream nextPut: $B. leftb _ 0. [leftb = -1] whileFalse: [ char _ aPositionableStream next. outStream nextPut: char. (char = $[ ) ifTrue: [leftb _ leftb + 1]. (char = $] ) ifTrue: [leftb _ leftb -1] ]. outString _ outStream contents. ATracer showData: outString. Stack add: (outString copyFrom: 1 to: outString size - 1). aPositionableStream next! noCr: aPositionableStream "converts CRs and TABs to SPACEs" | aCr aStream aTab | aCr _ Character cr. aTab _ Character tab. aStream _ ReadWriteStream on: String new. aPositionableStream do: [:i| ((aCr~=i) & (aTab~=i)) ifTrue: [aStream nextPut: i] ifFalse: [aStream nextPut: $ ]]. aStream reset. ^aStream! ! !CFInterpreter methodsFor: 'file I/O'! cd "changes directory -- " | aPath | aPath _ self pop. (aPath = '..') ifTrue: [CurPath _ TopPath] ifFalse: [CurPath _ CurPath,aPath,'/']! existFile "results true if the file exists -- b" (FileDirectory includesKey: self popPath) ifTrue: [Stack add: 1] ifFalse: [Stack add: 0]! loadLib "loads the whole Library --" | aFile aFileName | aFileName _ self popPath. aFile _ (FileStream oldFileNamed: aFileName). SysLib _ Compiler evaluate: aFile contentsOfEntireFile. self scfonly! loadWord "loads a word u --" | aWord aFile aFileName | aWord _ Stack removeLast. (aWord first = $#) ifTrue: [aFileName _ self popPath. aFile _ (FileStream oldFileNamed: aFileName). Library at: aWord put: aFile contentsOfEntireFile]! mkDir "makes a directory --" SystemCall makeDirectory: self popPath! popPath "make a real path out of a scf-path" | aPath | aPath _ self pop. ^(CurPath , aPath)! rmDir "removes a directory -- " SystemCall removeDirectory: self popPath! rmFile "removes a file -- " SystemCall removeFile: self popPath! saveLib "saves the whole Library --" | aStream someData aFilename aFile | aFilename _ self popPath. "aFilename _ aFilename copyFrom: 2 to: aFilename size." aStream _ WriteStream on: String new. SysLib storeOn: aStream. someData _ aStream contents. aFile _ (FileStream newFileNamed: aFilename). aFile nextPutAll: someData. aFile flush! saveWord "saves a word w --" | aWord aFile aFileName | aWord _ self pop. aFileName _ self popPath. "aFileName _ aFileName copyFrom: 2 to: aFileName size." aFile _ (FileStream newFileNamed: aFileName). aFile nextPutAll: aWord. aFile flush! ! !CFInterpreter methodsFor: 'control structures'! do "loops over every byte in w1: put byte on stack and execute w2 w1 w2 --" | aBlock aString aCFI | aBlock _ self pop. aString _ self pop. aCFI _ CFInterpreter new. aString do: [:byte| Stack add: byte asciiValue. aCFI interpret: aBlock readStream]! exec "executes a word w --" | anElement anInterpreter | anElement _ self pop. anInterpreter _ CFInterpreter new. anInterpreter interpret: (ReadStream on: anElement)! filter "executes for every byte in w. If Boolfunc returns true, then append the byte to the new word u w u --" | aWord aBlock someData aCFI newData | aWord _ Stack removeLast. aBlock _ self pop. someData _ self pop. aCFI _ CFInterpreter new. newData _ someData select: [:i| Stack add: i asciiValue. aCFI interpret: aBlock readStream. Stack removeLast = 1]. Library at: aWord put: newData! for "loop w from i2 to i1 by 1 i1 i2 w --" | aFunction aInterpreter | aFunction _ self pop. aInterpreter _ CFInterpreter new. (Stack removeLast to: Stack removeLast by: 1) do: [ :i | aInterpreter interpret: (ReadStream on: aFunction)]! forBy "loops w from i2 to i1 by i3 i1 i2 i3 w --" | aFunction aInterpreter someInc | aFunction _ self pop. someInc _ Stack removeLast. aInterpreter _ CFInterpreter new. (Stack removeLast to: Stack removeLast by: someInc) do: [ :i | aInterpreter interpret: (ReadStream on: aFunction)]! fori "loop w from i2 to i1 by 1. put the index on stack before looping i1 i2 w --" | aFunction aInterpreter | aFunction _ self pop. aInterpreter _ CFInterpreter new. (Stack removeLast to: Stack removeLast by: 1) do: [ :i | Stack add: i. aInterpreter interpret: (ReadStream on: aFunction)]! foriBy "loop w from i2 to i1 by i3 . put index on stack before looping i1 i2 i3 w --" | aFunction aInterpreter someInc | aFunction _ self pop. someInc _ Stack removeLast. aInterpreter _ CFInterpreter new. (Stack removeLast to: Stack removeLast by: someInc) do: [ :i | Stack add: i. aInterpreter interpret: (ReadStream on: aFunction)]! if "executes w if b is true b w --" | aFunction aInterpreter | aFunction _ self pop. (Stack removeLast = 1) ifTrue: [aInterpreter _ CFInterpreter new. aInterpreter interpret: (ReadStream on: aFunction)]! ifElse "executes w1 if b is true else execute w2 b w1 w2 --" | aFunction elseFunction aInterpreter | elseFunction _ self pop. aFunction _ self pop. aInterpreter _ CFInterpreter new. (Stack removeLast = 1) ifTrue: [aInterpreter interpret: (ReadStream on: aFunction)] ifFalse: [aInterpreter interpret: (ReadStream on: elseFunction)]! nif "executes w if b is false b w --" | aFunction aInterpreter | aFunction _ self pop. (Stack removeLast = 0) ifTrue: [aInterpreter _ CFInterpreter new. aInterpreter interpret: (ReadStream on: aFunction)]! until "execute body. execute boolean function. if value is false, repeat from start w --" | bodyFunction booleanFunction aInterpreter | booleanFunction _ self pop. bodyFunction _ self pop. aInterpreter _ CFInterpreter new. aInterpreter interpret: (ReadStream on: bodyFunction). [aInterpreter interpret: (ReadStream on: booleanFunction). (Stack removeLast = 0)] whileTrue: [aInterpreter interpret: (ReadStream on: bodyFunction)]! while "if boolean function is true execute body and begin from start w --" | bodyFunction booleanFunction aInterpreter | bodyFunction _ self pop. booleanFunction _ self pop. aInterpreter _ CFInterpreter new. [aInterpreter interpret: (ReadStream on: booleanFunction). (Stack removeLast = 1)] whileTrue: [aInterpreter interpret: (ReadStream on: bodyFunction)]! ! !CFInterpreter methodsFor: 'variables'! addTo "adds n to the content of w w n --" | aNumber | aNumber _ Stack removeLast. Stack add: Stack last. Stack add: self pop asNumber + aNumber. self vardef! divWith "divides n with the content of w w n --" | aNumber | aNumber _ Stack removeLast. Stack add: Stack last. Stack add: self pop asNumber // aNumber. self vardef! fetch "fetches the value of a variable w -- e" Stack add: self pop asNumber! locdef "defines a local word in a block u w --" | value | value _ self pop. dictionary at: Stack removeLast put: value! locvardef "defines a local variable in a block u e --" | value | value _ Stack removeLast. dictionary at: Stack removeLast put: value printString! mulWith "multiplicates n with the content of w w n --" | aNumber | aNumber _ Stack removeLast. Stack add: Stack last. Stack add: self pop asNumber * aNumber. self vardef! showLoc "shows local dictionary in the transcript" | aStream | aStream _ WriteStream on: String new. dictionary printOn: aStream. Transcript show: aStream contents; cr! store "stores a value in a global variable w e --" self vardef! subFrom "subtracts n from the content of w w n --" | aNumber | aNumber _ Stack removeLast. Stack add: Stack last. Stack add: self pop asNumber - aNumber. self vardef! vardef "defines a variable i.e. a word with stacklength and contents e u e --" | aThing | aThing _ Stack removeLast. Library at: Stack removeLast put: aThing printString! ! !CFInterpreter methodsFor: 'libraries'! find: aKey "find a value to aKey" | value aStream aFileName | (dictionary includesKey: aKey) ifTrue: [value _ dictionary at: aKey] ifFalse: [LibStack do: [:i| (i includesKey: aKey) ifTrue: [value _ i at: aKey]]]. (value isNil) ifTrue: [CFInterpreter error] ifFalse: [^value]! library "defines a library u --" | aLibrary aDictionary | aLibrary _ Stack removeLast. aDictionary _ Dictionary new. Library at: aLibrary put: aDictionary. Library _ aDictionary. LibStack add: aDictionary! push "pushes a library on the LibStack w --" | aLibrary | aLibrary _ self pop. Library _ aLibrary. LibStack add: aLibrary! rmLib "removes a library (including all words) w --" | aLib aName | aName _ Stack removeLast. aLib _ Library at: aName. aLib keysDo: [:i| aLib removeKey: i]. Library removeKey: aName! scfOnly "clears the LibStack and pushes SysLib on it --" LibStack _ OrderedCollection new. LibStack add: SysLib. Library _ SysLib! showLS "show LibStack" | aStream | aStream _ WriteStream on: String new. SysLib printOn: aStream. Transcript show: aStream contents; cr! ! !CFInterpreter methodsFor: 'userinterface'! addText "adds some text to a textwindow --" | aText | aText _ self pop. (ConDic at: Stack removeLast) show: aText withCRs! binChoice "opens a binary choice -- b" BinaryChoice message: self pop displayAt: Sensor mousePoint centered: true ifTrue: [Stack add: 1] ifFalse: [Stack add: 0]! bindMenu "binds a popup menu to a picture window --" | aWId aBlock aText | aWId _ Stack removeLast. aBlock _ self pop. aText _ self pop. (ConDic at: aWId) menutext: aText block: [:i| Stack add: i. CFInterpreter new interpret: aBlock readStream]! circle "draws a circle at c1,c2 with radius c3 and linewidth c4 c1 c2 c3 c4 --" | xo yo radius aPic aWidth | aWidth _ Stack removeLast. radius _ Stack removeLast. yo _ Stack removeLast. xo _ Stack removeLast. aPic _ CFInterpreter returnController: (Stack removeLast). aPic circleAt: xo@yo radius: radius width: aWidth! clearTextWindow "clears a textwindow --" (ConDic at: Stack removeLast) clear! cli "A Command Line Interpreter is a combined Input-/Outputwindow. It gets one line of text from the user, puts it on stack and executes it by using Block -- " | aBlock aCLI | aBlock _ self pop. aCLI _ CLI new. aCLI thing: aBlock. aCLI shell: [:line :aBlock | Stack add: line. CFInterpreter new interpret: aBlock readStream]. [CLIView open: aCLI label: 'CLI'] fork. CFInterpreter addController: aCLI! cliShow "shows some text in a CLI-Window --" | aWId aText | aWId _ Stack removeLast. aText _ self pop. (ConDic at: aWId) cr; show: aText! close "closes a window using ConDic --" | aController | aController _ ConDic at: Stack removeLast. aController close. aController controlTerminate! editWordNow "opens an editor for a word u --" | aName aText | aText _ self pop. aName _ Stack last. (Library includesKey: aName) ifFalse: [Library at: aName put: '-empty-']. FillInTheBlank request: aText displayAt: Sensor waitButton centered: true action: [:answer | Stack add: answer. self def] initialAnswer: (Library at: aName)! getCardinalNow "requests a cardinal number by asking -- c" FillInTheBlank request: self pop displayAt: Sensor mousePoint centered: true action: [:answer | Stack add: answer asNumber] initialAnswer: ''! getFilePath "requests a file path asking text -- " FillInTheBlank request: self pop displayAt: Sensor mousePoint centered: true action: [:answer | Stack add: (self pop),answer] initialAnswer: ''! getTextNow "requests some text by asking -- " FillInTheBlank request: self pop displayAt: Sensor mousePoint centered: true action: [:answer | Stack add: answer] initialAnswer: ''! graphicWindow "opens a graphical window with width c1 and heigth c2 c1 c2 -- " | aWidth aHeigth aPic | aHeigth _ Stack removeLast. aWidth _ Stack removeLast. aPic _ Picture newSize: aWidth@aHeigth. [PictureView open: aPic] fork. CFInterpreter addController: aPic! hypertextWindow "forks a hypertextwindow -- " | aHyperTextView | [ HyperTextView open: self pop] fork! keyHandler "binds a key handler to a picture window --" | aBlock aCLI aWId | aWId _ Stack removeLast. aBlock _ self pop. (ConDic at: aWId) shell: [:aKey | Stack add: aKey. CFInterpreter new interpret: aBlock readStream]! line "draws a line from c1,c2 to c3,c4 c1 c2 c3 c4 --" | xo yo xd yd aPic | yd _ Stack removeLast. xd _ Stack removeLast. yo _ Stack removeLast. xo _ Stack removeLast. aPic _ CFInterpreter returnController: (Stack removeLast). aPic lineFrom: xo@yo to: xd@yd! linearOutput "opens a linear output c -- " | aSlider topView myController aValue | aValue _ Stack removeLast. aSlider _ Slider new. aSlider initValue: aValue. topView _ StandardSystemView new label: self pop. topView model: aSlider. topView borderWidth: 2. topView insideColor: Form white. topView minimumSize: 200@50. topView addSubView: (SliderView linearOutput: aSlider). myController _ topView controller. CFInterpreter addController: myController. [myController open] fork! linearOutputMove "sets a new value for a linear output c -- " | sliderController aValue | aValue _ Stack removeLast. sliderController _ ConDic at: Stack removeLast. sliderController model value: aValue! oneOfn "opens a selection of strings -- " | aBlock aList topView aSCFList aController | aBlock _ self pop. aList _ self pop. topView _ StandardSystemView new. aSCFList _ (SCFList new) putList: aList putShell: [:i| Stack add: i. CFInterpreter new interpret: aBlock]. topView addSubView: (SelectionInListView on: aSCFList aspect: #anItem change: #focusOn: list: #fullList menu: nil initialSelection: nil) in: (0@0 extent: 1@1) borderWidth: 1. aController _ topView controller. CFInterpreter addController: aController. [aController open] fork! openIcon "opens an icon -- " | aPic aBlock topView size aButton aButtonView aController | (Stack last isKindOf: String) ifTrue: [aPic _ self pop] ifFalse: [aPic _ Stack removeLast]. aBlock _ self pop. size _ aPic size + 4. topView _ StandardSystemView new. topView minimumSize: size. topView maximumSize: size. topView borderWidth: 2. aButton _ Button newOff. aButton onAction: [CFInterpreter new interpret: aBlock readStream]. aButtonView _ SwitchView new model: aButton. aButtonView label: aPic form. aButtonView insideColor: Form white. topView addSubView: aButtonView. aController _ topView controller. CFInterpreter addController: aController. [aController open] fork! picload "loads a picture from disk -- " | aPic | aPic _ Form readFrom: self pop. Stack add: (Picture on: aPic)! picloadWindow "loads and opens a window containing a picture -- " | aPic | aPic _ Picture on: (Form readFrom: self pop). [PictureView open: aPic] fork. CFInterpreter addController: aPic! picWindow "opens a window containing a picture -- " | aPic | (Stack last isKindOf: String) ifTrue: [aPic _ self pop] ifFalse: [aPic _ Stack removeLast]. [PictureView open: aPic] fork. CFInterpreter addController: aPic! popUp "opens a popup menu. c is the index of the choosen line -- c" Stack add: (PopUpMenu labels: self pop withCRs) startUp! textWindow "forks a textwindow -- " | aCLI | aCLI _ CLI new contents: self pop withCRs. [ CLIView open: aCLI label: 'Textfenster'] fork. CFInterpreter addController: aCLI! whenMouseKlick "sets a mouseklickhandler to a picture window w --" | aBlock | aBlock _ self pop. (ConDic at: Stack removeLast) klickhandler: [:x :y| Stack add: x. Stack add: y. CFInterpreter new interpret: aBlock readStream]! wipe "wipes a box in a picture window from c1,c2 to c1+c3,c2+c4 c1 c2 c3 c4 --" | xo yo xd yd aPic | yd _ Stack removeLast. xd _ Stack removeLast. yo _ Stack removeLast. xo _ Stack removeLast. aPic _ CFInterpreter returnController: (Stack removeLast). aPic wipeFrom: xo@yo to: xd@yd! ! !CFInterpreter methodsFor: 'error handling'! onEC1exec "on errors of the first stage exec word w --" EC1 _ self pop! onEC2closeWith "on errors of the first stage close with word w --" EC2 _ self pop! ! !CFInterpreter methodsFor: 'compile'! execute: aString "execute a compiled word" Stack add: '#',aString. ((Library at: aString) = #variable) ifTrue: [self fetch] ifFalse: [self exec]! isCompiled: aString "answer wether aString was been compiled" ^Library includesKey: aString! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CFInterpreter class instanceVariableNames: ''! !CFInterpreter class methodsFor: 'instance creation'! autointerpret: aFileName "interpret some code in the file " | aFile | self initializeSeparately. aFile _ (FileStream oldFileNamed: aFileName). self new interpret: (ReadStream on: aFile contentsOfEntireFile)! new "new new" ^super new initialize! ! !CFInterpreter class methodsFor: 'class initialisation'! initializeSeparately "initialize the stack and the library. Do not use ST80's auto-initialize" (SysLib isNil) ifTrue: [Stack _ Lifo new: 100. SysLib _ Dictionary new. Library _ SysLib. LibStack _ Lifo new. LibStack add: SysLib. ATracer _ Tracer new. Lifo tracer: ATracer. Step _ SingleStep new. EC1 _ nil. EC2 _ nil. Errors _ 0. TopPath _ ''. "This is the setting for the SCF-Path" CurPath _ ''. ConDic _ Dictionary new. Sleep _ Delay forMilliseconds: 0]! ! !CFInterpreter class methodsFor: 'accessing'! addController: aController "adds a Controller to ConDic" | i | self wipeConDic. i _ 0. [ConDic includesKey: i] whileTrue: [i _ i + 1]. ConDic at: i put: aController. Stack add: i! at: key put: value "defines a word in the System Dic" SysLib at: key put: value! pop "pops the TOP-OF-STACK" ^Stack removeLast! removeController: aController "removes a Controller from ConDic" ConDic removeKey: (ConDic keyAtValue: aController ifAbsent: [ -1]) ifAbsent: []! returnController: aKey "returns the controller to a key" ^ConDic at: aKey! setPaths: aPath "Install the right SCF-offset paths. SCF-programs cant call this method" CurPath _ aPath. TopPath _ aPath! singleStep "does the single step" Step signal! singleStepOff "switches the singleStep off" Step off! singleStepOn "switches the singleStep on" Step on! sleep: milliseconds "wait milliseconds after each codeelement" (milliseconds = 0) ifTrue: [ Sleep _ nil] ifFalse: [Sleep _ Delay forMilliseconds: milliseconds]! wipeConDic "wipes the ConDic (throw away unused controllers)" | aView | ConDic do: [:c| aView _ c view. (aView isNil) ifTrue: [self removeController: c]]! ! !CFInterpreter class methodsFor: 'error handling'! error "SCFerrorhandler. See documentation for detail information" | aCFI | (Errors > 1) ifTrue: [self halt: 'Errorclass 2 error occured. Kernel panic'] ifFalse: [aCFI _ CFInterpreter new. (Errors = 0) ifTrue: [(EC1 notNil) ifTrue: [aCFI interpret: EC1 readStream] ifFalse: [self halt: 'EC1 error and no EC1 handler']] ifFalse: [(EC2 notNil) ifTrue: [aCFI interpret: EC2 readStream] ifFalse: [self halt: 'EC2 error and no EC2 handler']]. Errors _ Errors +1]! ! !CFInterpreter class methodsFor: 'shell'! cli "opens a SCF command line interpreter" | aCFI aCLI | CFInterpreter initializeSeparately. aCFI _ CFInterpreter new. aCLI _ CLI new. aCLI thing: aCFI. aCLI shell: [:line :cfi | [cfi interpret: line readStream] fork]. self setCLI: aCLI. CLIView open: aCLI label: 'SCFLI'! setCLI: aCLI "sets the CLI variable" Cli _ aCLI! ! TextHolder subclass: #HyperText instanceVariableNames: 'aDictionary ' classVariableNames: '' poolDictionaries: '' category: 'SCF'! HyperText comment: 'This class provides a simple hypertext mechanism Embedded in the text, a link looks like this: ".....foo =[ some code] foo..." '! !HyperText methodsFor: 'accessing'! compile: someText "compile a text" | outStream sourceStream aStack aText until | aStack _ OrderedCollection new. aStack add: -1. sourceStream _ ReadStream on: someText. outStream _ WriteStream on: String new. [sourceStream atEnd] whileFalse: [ outStream nextPutAll: (sourceStream upTo: $<). (sourceStream atEnd) ifFalse: [aStack add: outStream position. outStream nextPutAll: (self link: sourceStream). aStack add: outStream position]]. aText _ Text fromString: outStream contents. [aStack last = -1] whileFalse: [until _ aStack removeLast. aText emphasizeFrom: aStack removeLast to: until with: 5]. self contents: aText! dictionary "returns the instance's dictionary" ^aDictionary! link: aPosStream "creates single hypertext links" | link leftb char outStream outString | link _ aPosStream upTo: $>. aPosStream upTo: $[. outStream _ WriteStream on: String new. leftb _ 0. [leftb = -1] whileFalse: [ char _ aPosStream next. outStream nextPut: char. (char = $[ ) ifTrue: [leftb _ leftb + 1]. (char = $] ) ifTrue: [leftb _ leftb -1] ]. outString _ outStream contents. aDictionary at: link put: (outString copyFrom: 1 to: outString size - 1). aPosStream next. ^' ',link,' '! ! !HyperText methodsFor: 'initialisation'! initialize "initialize the instance variable" super initialize. aDictionary _ Dictionary new! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! HyperText class instanceVariableNames: ''! !HyperText class methodsFor: 'instance creation'! new "new new" ^super new initialize! ! Semaphore subclass: #SingleStep instanceVariableNames: 'allow ' classVariableNames: '' poolDictionaries: '' category: 'SCF'! SingleStep comment: 'This class is a semaphore which only works if the instance variable is true.'! !SingleStep methodsFor: 'accessing'! off "comment stating purpose of message" allow _ false! on "comment stating purpose of message" allow _ true! signal "comment stating purpose of message" (allow) ifTrue: [super signal]! wait "waits is allow is true" (allow) ifTrue: [super wait]! ! !SingleStep methodsFor: 'initialize'! initialize "sets allow" allow _ false! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SingleStep class instanceVariableNames: ''! !SingleStep class methodsFor: 'instance creation'! new "new new" ^super new initialize! ! Model subclass: #SCFList instanceVariableNames: 'list shell line ' classVariableNames: '' poolDictionaries: '' category: 'SCF'! SCFList comment: 'This class provides a stand-alone Textselectionwindow. The shell is a block which is executed every single selection, which is the parameter for the block "SCFList openOn: ''one\two\three'' shell: [:i|Transcript show: i printString; cr]"'! !SCFList methodsFor: 'accessing'! anItem "returns current selection" ^line! focusOn: anItem "new focus on an item (executing shell using itemindex as parameter)" line _ anItem. (anItem notNil) ifTrue: [shell value: (list indexOf: anItem)]! fullList "returns full list" ^list! putList: aList putShell: aShell "sets the instance variables, converts aSCFlist in an array" | anArray aStream anOrderedCollection anElement | aStream _ ReadStream on: aList. anOrderedCollection _ OrderedCollection new. [aStream atEnd] whileFalse: [anElement _ aStream upTo: $\. anOrderedCollection add: anElement]. anArray _ Array new: anOrderedCollection size withAll: nil. [anOrderedCollection size = 0] whileFalse: [anArray at: anOrderedCollection size put: anOrderedCollection removeLast]. list _ anArray. shell _ aShell! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SCFList class instanceVariableNames: ''! !SCFList class methodsFor: 'instance creation'! openOn: aList shell: aShell "opens a Textlistwindow. list is a structure like one\two\three as string" | topView aSCFList | topView _ StandardSystemView new. aSCFList _ (self new) putList: aList putShell: aShell. topView addSubView: (SelectionInListView on: aSCFList aspect: #anItem change: #focusOn: list: #fullList menu: nil initialSelection: nil) in: (0@0 extent: 1@1) borderWidth: 1. topView controller open! ! Model subclass: #Picture instanceVariableNames: 'form myController keyhandler menuText menuBlock klickhandler ' classVariableNames: '' poolDictionaries: '' category: 'SCF'! Picture comment: 'This class provides a model for a picture i.e. a normal ST80-form'! !Picture methodsFor: 'accessing'! circleAt: aPoint radius: aNumber width: anotherNumber "draw a line" | pen aCircle | pen _ (Form new extent: anotherNumber@anotherNumber) black. aCircle _ Circle new. aCircle form: pen. aCircle radius: aNumber. aCircle center: aPoint. aCircle displayOn: form. self changed! close "use a picture like a controller" myController close! controlTerminate "dummy"! form "answer the form" ^form! form: aForm "sets the form" form _ aForm! handleKey: keyvalue "serves the keyhandlerblock with the keys value" (keyhandler notNil) ifTrue: [keyhandler value: keyvalue]! klickhandler: aBlock "sets the klickhandler e.g. [:x :y|Transcript show: x printString, y printString]" klickhandler _ aBlock! lineFrom: aPoint to: bPoint "draw a line" | pen | pen _ (Form new extent: 1@1) black. form _ form drawLine: pen from: aPoint to: bPoint clippingBox: form boundingBox rule: 3 mask: nil. self changed! menutext: aText block: aBlock "sets the yellow button menu" menuText _ aText. menuBlock _ aBlock! mouseKlick: aPoint "execute klickhandler with x and y as parameters" (klickhandler notNil) ifTrue: [Cursor wait beCursor. klickhandler value: aPoint x value: aPoint y. Cursor normal beCursor]! myController: aController "sets the controller" myController _ aController! popMenu "pops up the menu" (menuBlock notNil) ifTrue: [menuBlock value: (PopUpMenu labels: menuText withCRs) startUp]! shell: aBlock "sets the keyhandler" keyhandler _ aBlock! size "answer the size" ^(form boundingBox corner)! view "yet another controller method" ^myController view! wipeFrom: pointA to: pointB "wipes the box (A extent B)" form _ form fill: (pointA extent: pointB) rule: Form over mask: Form white. self changed! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Picture class instanceVariableNames: ''! !Picture class methodsFor: 'instance creation'! newSize: anExtent "creates a new Picture" | me | me _ super new. me form: (Form new extent: anExtent). ^me! on: aForm "creates a Picture from aForm" | me | me _ super new. me form: aForm. ^me! ! View subclass: #SliderView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SCF'! SliderView comment: 'The view of a slider'! !SliderView methodsFor: 'updating'! update: aParameter "redisplays everything" self display! ! !SliderView methodsFor: 'displaying'! displayView "displays the value of the model graphically" | box aPen value height | box _ self insetDisplayBox. aPen _ Pen new. height _ box height - 4. aPen sourceForm: (Form new extent: 1@height) gray. aPen up. aPen goto: box origin + (0@2). aPen down. value _ ((self model value) / 25) * box width. aPen goto: (box origin + (value@2))! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SliderView class instanceVariableNames: ''! !SliderView class methodsFor: 'instance creation'! linearOutput: aSlider "returns a SliderView on aSlider" | sliderView | sliderView _ SliderView new model: aSlider. sliderView insideColor: Form white. ^sliderView! on: aSlider "returns a SliderView on aSlider" | topView sliderView incrButton incrSwitchView decrButton decrSwitchView | topView _ View new. topView borderWidth: 1. sliderView _ SliderView new model: aSlider. sliderView insideColor: Form white. topView addSubView: sliderView in: (0.25@0 extent: 0.5@1) borderWidth: 1. incrButton _ Button newOff. incrButton onAction: [ sliderView model inc]. incrSwitchView _ SwitchView new model: incrButton. incrSwitchView label: (('+' asDisplayText form) magnifyBy: 2@2). incrSwitchView insideColor: Form white. decrButton _ Button newOff. decrButton onAction: [ sliderView model dec]. decrSwitchView _ SwitchView new model: decrButton. decrSwitchView label: (('-' asDisplayText form) magnifyBy: 2@2). decrSwitchView insideColor: Form white. topView addSubView: decrSwitchView in: (0.75@0 extent: 0.25@1) borderWidth: 1. topView addSubView: incrSwitchView in: (0@0 extent: 0.25@1) borderWidth: 1. ^topView! !