├── .gitignore ├── README.md ├── Smalltalk78.js ├── crt ├── glfx.js └── index.html ├── devserver.js ├── favicon.png ├── index.html ├── index.png ├── notetaker ├── ObjectSpace.nt └── ObjectTable.nt ├── package-lock.json ├── package.json ├── ui.js ├── updates ├── .gitignore ├── 0001InitUpdates-bf.st ├── 0002fileInOut-di.st ├── 0003updates-bf.st ├── 0004imageSave-bf.st ├── 0005decompiler-di.st ├── 0006scrolling-di.st ├── 0007compileAll-di.st ├── 0008installError-di.st ├── 0009readFont-tk.st ├── 0010flushDisplay-bf.st ├── 0011cleanup-bf.st ├── 0012sqrt-yo.st ├── 0013autoNumber-bf.st ├── 0014InspectWindow.st ├── 0015FormWindow-bf.st ├── 0016menuAdditions-bf.st ├── 0017Font-loading.st ├── 0018ClickFix-di.st ├── 0019d1recognizerV1-yo.st ├── 0020largeString-bf.st ├── 0021windowInspect-bf.st ├── 0022D1Stream.st ├── 0023D1Stroke.st ├── 0024D1Recognizer.st ├── 0025ObjErrorFix.st ├── 0026trigprims-yo.st ├── 0027bring in fonts.st ├── 0028inkrecognizer-yo.st ├── 0029messageDict-bf.st ├── 0030FileEdit-di.st ├── 0031reclassifyRecog-yo.st ├── 0032recogWindow-yo.st ├── 0033windowResize-bf.st ├── 0034restoreWindows-bf.st ├── 0035SundryFixes-di.st ├── 0036allInstances-bf.st ├── 0037varInstances-bf.st ├── 0038moreResize-bf.st ├── 0039fixClass-bf.st ├── 0040formEffects-bf.st ├── 0041load-Logo24-font.st ├── 0042Reorganize-di.st ├── 0043LogoPatch-di.st ├── 0044closeWindow-bf.st ├── 0045fixNotifiers-bf.st ├── 0046lshiftFix-bf.st ├── 0047formInv-bf.st ├── 0048addD1Top-yo.st ├── 0049kbd.st ├── 0050inspectFix-bf ├── 0051fixDelete-bf.st ├── 0052clipText-bf.st ├── 0053StackPaneSources-di.st ├── 0054ClassSources-di.st ├── 0055widetitlebar-yo.st ├── 0056assets-bf.st ├── 0057ClassReshape-di.st ├── 0058largeIntPrims-bf.st ├── 0059projectBackground-bf.st ├── 0060fileMenuEtc-bf.st ├── 0061menu-bf.st ├── 0062clipboard-bf.st ├── 0063floatConstants-bf.st ├── 0064revTitle2-yo.st ├── 0065boldTitle-yo.st ├── 0066TurtleChanges-di.st ├── 0067editTitle1-yo.st ├── 0068TurtleChanges2-di.st ├── 0069fixUser-bf.st ├── 0070FontKerning-di.st ├── 0071SafeKern-di.st ├── 0072TurtleCleanup-di.st ├── 0073Box.st ├── 0074BitRectClasses-di.st ├── 0075ticksAndRecog-yo.st ├── 0076BitRect-filin.st ├── 0077turtleBatching-bf.st ├── 0078BitRectTweaks-di.st ├── 0079BitRectTweaks2-di.st ├── 0080FormWindow.st ├── 0081tabletGesture-yo.st ├── 0082boxCoords-yo.st ├── 0083backgroundForm-bf.st ├── 0084minorD1Opt-yo.st ├── 0085filout-bf.st ├── 0086moreRecogPane-yo.st ├── 0087BitRectTweaks3-di.st ├── 0088user-bf.st ├── 0089asset-bf.st ├── 0090moreUser-bf.st ├── 0091recogLR-yo.st ├── 0092ProjectSorter-di.st ├── 0093ProjectSorterTweaks-di.st ├── 0094misc-bf.st ├── 0095sorter-bf.st ├── 0096black-white-fix.st ├── 0097sorterFixes-bf.st ├── 0098moveByKeyboard-bf.st ├── 0099shiftRecog-yo.st ├── 0100keyset-bf.st ├── 0101BadMethodSources-di.st ├── 0102RecogCursor-yo.st ├── 0103moreGestures-yo.st ├── 0104FixSubclasses-di.st ├── 0105moveNicely-bf.st ├── 0106FreeMethods-di.st ├── 0107updateGC-bf.st ├── 0108MoreReshaping-di.st ├── 0109windowStyle-bf.st ├── 0110BitRectTweaks4-di.st ├── 0111misc-bf.st ├── 0112noBorder-bf.st ├── 0113windowStyles-bf.st ├── 0114FatBitsTweaks-di.st ├── 0115largeIntAt-yo.st ├── 0116Helvetica-declare-tk.st ├── 0117Helvetica-load-tk.st ├── 0118TextFrame-style-tk.st ├── 0119newRecogCursor.st ├── 0120sundry-bf.st ├── 0121D1PathDistancePrim-yo.st ├── 0122fixCursors-bf.st ├── 0123cachePointsInD1-yo.st ├── 0124D1select-yo.st ├── 0125Fonted1-di.st ├── 0126hideScrollbar-bf.st ├── 0127windowLeave-bf.st ├── 0128windowClose-bf.st ├── 0129fixNTkbMap-bf.st ├── 0130deleteFile-bf.st ├── 0131FontEditing-di.st ├── 0132filout-bf.st ├── 0133windowBits-bf.st ├── 0134arrange-fonts-tk.st ├── 0135ST72Font-declare-tk.st ├── 0136ST72Font-load-tk.st ├── 0137logChanges-bf.st ├── 0138formWindow-bf.st ├── 0139fontIncDec-bf.st ├── 0140doitInTablet-yo.st ├── 0141toBottom-bf.st ├── 0142ChooseLineHeight-di.st ├── 0143fullTitleFrame-bf.st ├── 0144titleFrameAgain-bf.st ├── 0145ToolpicEtc-di.st ├── 0146arrow1-yo.st ├── 0147Sequencer.st ├── 0148CalendarPage.st ├── 0149CalendarDemo.st ├── 0150arrowMove-bf.st ├── 0151moreArrow-bf.st ├── 0152arrowWindow2-yo.st ├── 0153arrowWindow3-yo.st ├── 0154ParcWindowsSeq.st ├── 0155FaucetSeq.st ├── 0156FormWindowEditItem-di.st ├── 0157batchArrow-yo.st ├── 0158CodeWindowInit-di.st ├── 0159CodeWindowInFrame-di.st ├── 0160RosettaSeq.st ├── 0161LibrarySeq.st ├── 0162shapes1-yo.st ├── 0163shapes2-yo.st ├── 0164shapes3-yo.st ├── 0165disableCache-yo.st ├── 0166simpleShapes-yo.st ├── 0167RestoreFix-di.st ├── 0168ImplementersMenu-di.st ├── 0169RestoreTweak-di.st ├── 0170RestoreTweak2-di.st ├── 0171RestoreTweak3-di.st ├── 0172Learn-di.st ├── 0173arrowMidPoint-yo.st ├── 0174windowInTextframe-yo.st ├── 0175Listener1-di.st ├── 0176SetTitle-di.st ├── 0177DuplicateCodeWindow-di.st ├── 0178doitAndListen-bf.st ├── 0179DeactivateAndTick-di.st ├── 0180copyStyle-bf.st ├── 0181kbdResize-bf.st ├── 0182DebugFrameFixAgain-di.st ├── 0183listenerTabs-bf.st ├── 0184TurtleFix-di.st ├── 0185TurtleFix2-di.st ├── 0186D1doit-yo.st ├── 0187TurtleFix3-di.st ├── 0188Ticking-di.st ├── 0189shapeDrag-bf.st ├── 0190editTitle-bf.st ├── 0191scrollBar-bf.st ├── 0192listenerEar.st ├── 0193altoPrompt-bf.st ├── 0194Convenience-di.st ├── 0195ActivateTweak-di.st ├── 0196ActivateTweak2-di.st ├── 0197hideInactive-bf.st ├── 0198formWindowTitle-bf.st ├── 0199cursorKeys-bf.st ├── 0200misc-bf.st ├── 0201TextPrimitive-di.st ├── 0202userRecog-bf.st ├── 0203deselectAfterDoit-bf.st ├── 0204kernedText-bf.st ├── 0205pickItem-bf.st ├── 0206screenRecog-yo.st ├── 0207textTweaks-bf.st ├── 0208formModes-bf.st ├── 0209recogCreateWindow-yo.st ├── 0210recogShapeDelete-yo.st ├── 0211userWait-bf.st ├── 0212doitCompileCancel-bf.st ├── 0213Helpers-di.st ├── 0214Animation-di.st ├── 0215indentOutdent-bf.st ├── 0216styleMenu-bf.st ├── 0217reflowForm-bf.st ├── 0218reflowForm2-bf.st ├── 0219requestRestart-bf.st ├── 0220projectNamed-bf.st ├── 0221reframeFirst-bf.st ├── 0222BREtweaks-di.st ├── 0223BREtweaks2-di.st ├── 0224BREtweaks3-di.st ├── 0225newProject-bf.st ├── 0226listKbd-bf.st ├── 0227textPrim-bf.st ├── 0228mouseOffset-bf.st ├── 0229eachtime-bf.st ├── 0230kbdSubst-bf.st ├── 0231kbdSubst2-bf.st ├── 0232kbdSubst3-bf.st ├── 0233changeLogFix-bf.st ├── 0234DebugFixes-di.st ├── 0235textRendering-bf.st ├── 0236filoutEscape-bf.st ├── 0237SomeOrganization-di.st ├── 0238AutoSelectAllMsgs-di.st ├── 0239menuFix-bf.st ├── 0240Removals-di.st ├── 0241projectIcon-bf.st ├── 0242Proceed1-di.st ├── 0243Org-fileOut-tk.st ├── 0244orgChanges-bf.st ├── 0245projectIcon2-bf.st ├── 0246projectIcon3-bf.st ├── 0247projectIcon4-bf.st ├── 0248Proceed3-di.st ├── 0249messageNotUnderstood-bf.st ├── 0250doit-bf.st ├── 0251ProcessOrgs-di.st ├── 0252framePrinting-bf.st ├── 0253notifierFrames-bf.st ├── 0254cacheWindowBits-bf.st ├── 0255textBackground-bf.st ├── 0256textDisplay-bf.st ├── 0257reposFix-bf.st ├── 0258Window-frame-.st ├── 0259textEffect-bf.st ├── 0260textEffect2-bf.st ├── 0261projectEnter-bf.st ├── 0262loadPic-bf.st ├── 0263charForm-bf.st ├── 0264formMenu-bf.st ├── 0265topWindowFix-bf.st ├── 0266formChar-bf.st ├── 0267animMenu-bf.st ├── 0268formEdit-bf.st ├── 0269labelledArrow-yo.st ├── 0270formEdit2-bf.st ├── 0271fontAsStrike-bf.st ├── 0272extentOfPigTailArrow-yo.st ├── 0273newArrowWithLabel-yo.st ├── 0274deleteDeleteGesture-yo.st ├── 0275arrowFix-yobf.st ├── 0276restartTick-bf.st ├── 0277SpawnClass-di.st ├── 0278InspectOrBrowse-di.st ├── 0279BrowseTweaks-di.st ├── 0280browseInspect-bf.st ├── 0281BrowseTweaks2fix-di.st ├── 0282UndeclaredHelp-di.st ├── 0283Merge-srcs-fix-tk.st ├── 0284MergeSrcs-fix-again-tk.st ├── 0285RecoverFromFilinError-di.st ├── 0286CodeWindowPreFrame-di.st ├── 0287keep-category-tk.st ├── 0288Source-ok-01-tk.st ├── 0289Source-ok-02-tk.st ├── 0290Source-ok-03-tk.st ├── 0291Source-ok-04-tk.st ├── 0292Source-ok-05-tk.st ├── 0293Source-ok-06-tk.st ├── 0294Source-ok-07A-tk.st ├── 0295Source-ok-07B-tk.st ├── 0296Source-ok-07C-tk.st ├── 0297Source-ok-21-tk.st ├── 0298Source-ok-22-tk.st ├── 0299benchmarks-bf.st ├── 0300https-bf.st ├── 0301floatmath-bf.st ├── 0302textsel-bf.st ├── 0303cleanMethods-bf.st ├── 0304DansCompRect.st ├── 0305editFileName-bf.st ├── 0306doNotKeepMethod-bf.st ├── 0307pigtailWindow-bf.st ├── 0308reportSpace-bf.st ├── 0309reorderMenu-bf.st ├── 0310workspaceExtent-bf.st ├── 0311multiLinePrompt-bf.st ├── 0312drawingFeb15-yo.st ├── 0313AmenddrawingFeb15-yo.st ├── 0314Amend2drawingFeb15-yo.st ├── 0315ProjectDuplicate-di.st ├── 0316ProjectSorterFix-di.st ├── 0317changes-3-1.st ├── 0318changes-3-2-di.st ├── 0319DateAndTime-di.st ├── 0320copyglyphs-bf.st ├── 0321ScriptHolder-etc-di.st ├── 0322SymbolTable-allGlobals.st ├── 0323SundryCleanups-di.st ├── 0324ImplicitSelfForAlan-di.st ├── 0325browseSendersEtc-di.st ├── 0326gasp-di.st ├── 0327updates-bf.st ├── 0328dirMenu-bf.st ├── 0329codefrau.st ├── 0330titleEditsFilename-vaf.st ├── 0331SearchTools.st ├── 0332ReshapeForm.st ├── 0333OpaqueForm.st ├── 0334AnimDemo.st ├── 0335FixesAndDate.st ├── 0336SourceCode-22.st ├── 0337Source-ok-01-tk.st ├── 0338Source-ok-02-tk.st ├── 0339Source-ok-03-tk.st ├── 0340Source-ok-04-tk.st ├── 0341Source-ok-05-tk.st ├── 0342Source-ok-06-tk.st ├── 0343Source-ok-07A-tk.st ├── 0344Source-ok-07B-tk.st ├── 0345Source-ok-07C-tk.st ├── 0346Fixes-2-21.st ├── 0347MethodTemps-22 Feb.st ├── 0348MethodTemps-24 Feb.st ├── 0349MethodTemps-25 Feb.st ├── 0350MethodTemps-26 Feb.st ├── 0351MethodTemps-27 Feb.st ├── 0352MethodTemps-28 Feb.st ├── 0353MethodTemps-1 Marc.st ├── 0354MethodTemps-2 Marc.st ├── 0355DanChanges-Mar13.st ├── 0356DanChanges-Mar20.st ├── 0357SearchAndSelect.st ├── 0358TextScrollFix.st ├── 0359fileBrowserTweaks.st ├── 0360FillsAndFixes.st ├── 0361DragAndResize.st ├── 0362BetterFileBrowser.st ├── 0363ChangesApr10.st ├── 0364filemenu-vaf.st ├── 0365object-recategorization-ff.st ├── 0366filepreview-vaf.st ├── 0367class-recategorization-ff.st ├── 0368filebrowser-vaf.st ├── 0369fixCharRecog-vaf.st ├── 0370fixFileBrowser-vaf.st ├── 0371fixDraw-vaf.st ├── 0372nicerMNU-vaf.st ├── 0373nicerFileBrowser-vaf.st ├── Helvetica11.strike ├── Helvetica13.strike ├── Helvetica14.strike ├── Helvetica18.strike ├── Helvetica25.strike ├── Helvetica36.strike ├── Helvetica48.strike ├── Logo24.strike ├── NewYork10B.strike ├── NewYork12B.strike ├── Palatino09.strike ├── Palatino12.strike ├── Palatino12B.strike ├── Palatino14.strike ├── Palatino14I.strike ├── Palatino16.strike ├── Palatino16I.strike ├── Palatino25.strike ├── Palatino25B.strike ├── ST72Font10.strike ├── actionpic.pic ├── altoPrompt.form ├── defaultpic.pic ├── ear.form ├── makeBaseImage-bf.st ├── toolpic.pic ├── updateStreamInit-bf.st └── updates.list └── vm.js /.gitignore: -------------------------------------------------------------------------------- 1 | decompiled 2 | assets 3 | node_modules 4 | *.st78 5 | *.code-workspace 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Smalltalk-78 2 | ============ 3 | Smalltalk-78 is a variant of Smalltalk-76 stripped down to work on the portable "NoteTaker" machine. 4 | In this repository is a Virtual Machine written in JavaScript to run a snapshot taken in 1979 in the web browser. 5 | 6 | To learn more, please read our paper [Reviving Smalltalk-78: The First Modern Smalltalk Lives Again][paper]. 7 | The full history of various Smalltalk releases is covered in Dan's [Evolution Of Smalltalk][hopl] article, 8 | which also includes links to a live version using this VM in the accompanying [Smalltalk Zoo][zoo] website. 9 | 10 | The [index.html][standalone] version in this directory gives you a running system, although the browser integration is incomplete (e.g. file management). Pull requests welcome! 11 | 12 | By default this runs an updated image with fixes (you may load more updates from wothin the system). 13 | If you feel adventurous, you can run the [original, unmodified image][original] as found on the disk pack, too. 14 | 15 | The full simulation environment including a graphical VM debugger is at the [Zoo's Smalltalk-78][full] page. 16 | There you can also try Adele Goldberg's SimKit and Alan Borning's ThingLab images running on this VM. 17 | 18 | [zoo]: https://smalltalkzoo.thechm.org/ 19 | [full]: https://smalltalkzoo.thechm.org/HOPL-St78.html 20 | [standalone]: https://codefrau.github.io/Smalltalk78/?fresh 21 | [original]: https://codefrau.github.io/Smalltalk78/?image=notetaker 22 | [paper]: https://freudenbergs.de/vanessa/publications/Ingalls-2014-Smalltalk78.pdf 23 | [hopl]: https://smalltalkzoo.thechm.org/papers/EvolutionOfSmalltalk.pdf 24 | -------------------------------------------------------------------------------- /devserver.js: -------------------------------------------------------------------------------- 1 | // this is a simple dev server for testing Smalltalk78 2 | // it serves static files and directory listings 3 | // and allows uploading files (e.g. to the /updates/ directory) 4 | 5 | // usage: 6 | // npm i 7 | // node devserver.js 8 | 9 | // in Smalltalk78: 10 | // "upload a file" 11 | // user fileString: 'http:foo/bar.txt' ← 'hello'. 12 | // "use local update stream" 13 | // updateURL ← 'http:updates/'. 14 | // "see all updates" 15 | // user fileString: updateURL 16 | 17 | const express = require('express'); 18 | const serveIndex = require('serve-index') 19 | const fs = require('fs'); 20 | const path = require('path'); 21 | const app = express(); 22 | const port = 8000; 23 | 24 | // log requests 25 | app.use((req, res, next) => { 26 | console.log(`${req.method} ${req.url}`); 27 | next(); 28 | }); 29 | 30 | // set req.body to raw body 31 | app.use(express.raw({ type: '*/*' })); 32 | 33 | // upload files 34 | app.put("/*", (req, res, next) => { 35 | const filepath = path.join(".", req.path); 36 | const dir = filepath.slice(0, filepath.lastIndexOf('/')); 37 | if (!fs.existsSync(dir)) { 38 | console.log(`==> creating directory ${dir}`); 39 | fs.mkdirSync(dir, { recursive: true }); 40 | } 41 | console.log(`==> storing ${req.body.length} bytes at ${filepath}`); 42 | const stream = fs.createWriteStream(filepath); 43 | stream.write(req.body); 44 | stream.end(); 45 | res.send(`Uploaded ${req.path}`); 46 | }); 47 | 48 | // serve static files and directory listings 49 | app.use(express.static('.'), serveIndex('.')); 50 | 51 | // start server 52 | app.listen(port, () => { 53 | console.log(`Server listening at ${port}`); 54 | }); 55 | -------------------------------------------------------------------------------- /favicon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/favicon.png -------------------------------------------------------------------------------- /index.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/index.png -------------------------------------------------------------------------------- /notetaker/ObjectSpace.nt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/notetaker/ObjectSpace.nt -------------------------------------------------------------------------------- /notetaker/ObjectTable.nt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/notetaker/ObjectTable.nt -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "description": "this file only provides 'npm start' to run a web server with PUT support for updates. Smalltalk78 itself has no dependencies.", 3 | "scripts": { 4 | "start": "node devserver.js" 5 | }, 6 | "devDependencies": { 7 | "express": "^4.18.2", 8 | "serve-index": "^1.9.1" 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /updates/.gitignore: -------------------------------------------------------------------------------- 1 | [^0-9]*.st 2 | updated*.st78 3 | -------------------------------------------------------------------------------- /updates/0001InitUpdates-bf.st: -------------------------------------------------------------------------------- 1 | 'Declare updateLevel and updateURL NOTE: this update was edited retroactively to reflect the new update stream URL.' [Smalltalk has: updateLevel  [] Smalltalk declare: updateLevel as: 0. Smalltalk has: updateURL  [] Smalltalk declare: updateURL as: 'https://smalltalkzoo.thechm.org/users/codefrau/St78/updates/'] -------------------------------------------------------------------------------- /updates/0004imageSave-bf.st: -------------------------------------------------------------------------------- 1 | 'Restore display after startup' UserView understands: 'primSave [user croak] primitive: 45' classified: 'As yet unclassified' UserView understands: 'primScreenExtent [self croak] primitive: 41' classified: 'As yet unclassified' UserView understands: 'save | t1 [user currentDisplay: (Form new extent: 1  1 bits: ''--'' offset: nil). user primSave. t1 _ user primScreenExtent. user currentDisplay: (Form new extent: t1 bits: (String new: t1 x * t1 y / 8) offset: nil). user restore]' classified: 'As yet unclassified' UserView understands: 'screenextent: t1 tab: t2 [htab _ t2 x | 16. screenrect _ 0  0 rect: t1 x | 32  (t1 y | 2). self currentCursor: currentCursor. self reconfigure. self restore]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0008installError-di.st: -------------------------------------------------------------------------------- 1 | 'Fix error in Object' Object understands: 'installError | t1 t2 [t1 _ Object md method: error. SpecialOops  1 _ t1]' classified: 'As yet unclassified' MessageDict understands: 'killmethod: t1 [methods  (self findorerror: t1) _ nil]' classified: 'As yet unclassified' ClassOrganizer understands: 'deleteEmptyCategories | t1 t2 [for t1 from: self categories do [t2 _ commentVector find: t1. (groupVector  t2) empty  [self deleteCategory: t2]]]' classified: 'As yet unclassified' UserView understands: 'fixesFeb17 | t1 t2 t3 [t1 _ ''user fixesFeb17''. t1 _ ''put items back in the Smalltalk dictionary''. Smalltalk declare: (ParsedObjectReference Method ParsedFieldReference ObjectInspector ) from: Undeclared. SystemOrganization classify: ParsedObjectReference under: ''Compiler''. SystemOrganization classify: ParsedFieldReference under: ''Compiler''. SystemOrganization classify: ObjectInspector under: ''Windows''. SystemOrganization classify: Method under: ''Compiler''. SystemOrganization classify: CompiledMethod under: ''Compiler''. for t2 from: SystemOrganization categories do [for t3 from: (SystemOrganization category: t2) do [Smalltalk  t3  nil  [Smalltalk delete: t3. SystemOrganization delete: t3]]]. SystemOrganization deleteEmptyCategories. t1 _ ''replace bad method''. Object md killmethod: error. Object understands: ''error | sender op n args i "after compiling execute: nil installError. " [sender _ thisContext sender. op _ sender thisop. n _ op numArgs. args _ Vector new: n. for i from: (n to: 1 by: 1) do [argsi _ sender pop]. self messageNotUnderstood: op withArgs: args from: sender]''. nil installError]' classified: 'As yet unclassified' user fixesFeb17  -------------------------------------------------------------------------------- /updates/0009readFont-tk.st: -------------------------------------------------------------------------------- 1 | 'Strike font reading' Font understands: 'fromStrike: t1 | t2 t3 [name _ t1. t2 _ dp0 oldFile: name + ''.strike.''. t2 nextword. minascii _ t2 nextword. maxascii _ t2 nextword. maxwidth _ t2 nextword. length _ t2 nextword. ascent _ t2 nextword. descent _ t2 nextword. xoffset _ t2 nextword. raster _ t2 nextword. glyphs _ t2 next: self byteraster * self height. xtable _ (Vector new: maxascii + 3) all_ 0. for t3 from: (minascii + 1 to: maxascii + 3) do [xtable  t3 _ t2 nextword]]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0010flushDisplay-bf.st: -------------------------------------------------------------------------------- 1 | 'Flush display while animating' UserView understands: 'displayFlush [self primScreenExtent]' classified: 'As yet unclassified' Rectangle understands: 'flash [self comp. user displayFlush. self comp. user displayFlush]' classified: 'As yet unclassified' Dispframe understands: 'show | t1 [text show: self contents asParagraph. until text lastshown  position do [t1 _ text scrolln: 1. position < t1  [] t1 _ array copy: t1 + 1 to: position. text show: t1 asParagraph. position _ 0. self append: t1]. user displayFlush]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0011cleanup-bf.st: -------------------------------------------------------------------------------- 1 | 'Remove unneeded methods' UserView derstands: fixesFeb17. UserView derstands: updateStreamInit.  -------------------------------------------------------------------------------- /updates/0012sqrt-yo.st: -------------------------------------------------------------------------------- 1 | 'add float primitiv' Float understands: 'sqrt | t1 t2 [[self  0.0  [self = 0.0  [0.0] user notify: ''sqrt invalid for x<0.'']]. t1 _ self + 0.0. t1 instfield: 1 _ (t1 instfield: 1) / 4 * 2. for t2 to: 5 do [t1 _ self - (t1 * t1) / (t1 * 2.0) + t1]. t1] primitive: 200' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0013autoNumber-bf.st: -------------------------------------------------------------------------------- 1 | 'Automatically number updates' UserView understands: 'update: fName _ contents | updates num file each [updates _ self updatesAvailable. num _ (updates length + 1) asString. while num length < 4 do [num _ ''0'' + num]. fName _ num + fName. self fileString: (updateURL + fName) _ contents. self cr; show: ''Published '' + fName. updates _ updates , fName. file _ Stream default. file append: ''Notetaker updates''. for each from: updates do [file cr; append: each]. self fileString: updateURL + ''updates.list'' _ file contents. self cr; show: ''Updated list''. updates]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0015FormWindow-bf.st: -------------------------------------------------------------------------------- 1 | Class new title: FormWindow subclassof: Window fields: 'form' declare: 'actionMenu ' FormWindow understands: 'form: aForm [form _ aForm. self newframe. self show]' classified: 'As yet unclassified'  FormWindow understands: 'show [form displayat: frame origin effect: 0 clippedBy: user screenrect]' classified: 'As yet unclassified'  FormWindow understands: 'newframe | t1 [user waitnobug. [frame  nil  [] self aboutToFrame. self erase]. t1 _ OriginCursor showwhile [user waitbug]. self frame: (t1 extent: form extent). self takeCursor]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0017Font-loading.st: -------------------------------------------------------------------------------- 1 | Font understands: 'fromStrike: name stream: t2 | t3 [t2 nextword. minascii _ t2 nextword. maxascii _ t2 nextword. maxwidth _ t2 nextword. length _ t2 nextword. ascent _ t2 nextword. descent _ t2 nextword. xoffset _ t2 nextword. raster _ t2 nextword. glyphs _ t2 next: self byteraster * self height. xtable _ (Vector new: maxascii + 3) all_ 0. for t3 from: (minascii + 1 to: maxascii + 3) do [xtable  t3 _ t2 nextword]]' classified: 'as yet unclassified'. StyleSheet understands: 'fontset [ fontset]' classified: 'as yet unclassified'. -------------------------------------------------------------------------------- /updates/0019d1recognizerV1-yo.st: -------------------------------------------------------------------------------- 1 | 'a tentative measure' 2 | -------------------------------------------------------------------------------- /updates/0020largeString-bf.st: -------------------------------------------------------------------------------- 1 | 'extend string file format to large strings' Stream understands: 'nextString | length [length _ self next. self into: (String new: [ length < 192  [length] length _ (length - 192) * 256 + self next. "original Notetaker encoding" length  192  [length] "yep, original" "new encoding for very large strings" length _ length * 256 + self next. length _ length * 256 + self next])]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0021windowInspect-bf.st: -------------------------------------------------------------------------------- 1 | 'inspect from blue button menu' Window understands: 'bluebug | t1 [t1 _ windowmenu bug. t1 = 1  [exitflag _ false. exitflag] t1 = 2  [self newframe. self enter] t1 = 3  [self close. self erase. user unschedule: self. false] t1 = 4  [self hardcopy] t1 = 5  [self print] t1 = 6  [self inspect]]' classified: 'As yet unclassified' Window understands: 'classInit [border _ 2  2. titleframe _ Textframe new para: nil frame: nil. titleloc _ 3  (4 - titleframe lineheight). titlerun _ String new: 2. titlerun word: 1 _ 255. windowmenu _ Menu new string: ''under frame close print printbits inspect '']' classified: 'As yet unclassified' Window classInit  -------------------------------------------------------------------------------- /updates/0022D1Stream.st: -------------------------------------------------------------------------------- 1 | Class new title: D1Stream subclassof: Object fields: ' hot cool hotStart hotEnd coolStart coolEnd' declare: '' D1Stream understands: 'shift [[hot  nil  [coolStart _ coolStart + 1.  self] true  [hot _ nil]]]' classified: 'As yet unclassified'  D1Stream understands: 'push: anObject [self shift. hot _ anObject]' classified: 'As yet unclassified'  D1Stream understands: 'prev [[hot  nil  [ cool  coolStart]].  hot]' classified: 'As yet unclassified'  D1Stream understands: 'current [[hot  nil  [ cool  (coolStart + 1)]].  cool  coolStart]' classified: 'As yet unclassified'  D1Stream understands: 'atEnd [ (hot  nil and [coolStart = cool length]) or [nil  hot and [coolStart > cool length]]]' classified: 'As yet unclassified'  D1Stream understands: 'init: aVector [cool _ aVector. coolStart _ 2. coolEnd _ aVector length. hot _ cool  1] ' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0025ObjErrorFix.st: -------------------------------------------------------------------------------- 1 | 'fixes sender error in Object>>error. Also restores source for update msgs' UserView understands: 'update: fileName message: msg _ changes [self update: fileName message: msg postscript: false _ changes]' classified: 'As yet unclassified'  UserView understands: 'update: fileName message: msg postscript: ps _ chgs | strm [strm _ Stream default. strm print: msg; cr; next_ 30. [chgs is: String  [strm append: chgs] self filoutChanges: chgs on: strm]. [ps  [strm append: ps; cr; next_ 30]]. self update: fileName _ strm contents]' classified: 'As yet unclassified'  Object understands: 'error | sender op n args i "after compiling execute: nil installError. " [sender _ thisContext current sender. op _ sender thisop. n _ op numArgs. args _ Vector new: n. for i from: (n to: 1 by: 1) do [argsi _ sender pop]. self messageNotUnderstood: op withArgs: args from: sender]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0026trigprims-yo.st: -------------------------------------------------------------------------------- 1 | Float understands: 'cos [self < 0.0  [(self + halfpi) sin] (halfpi - self) sin] primitive: 201' classified: 'As yet unclassified'  Float understands: 'sin | t1 t2 t3 t4 [self < 0.0  [self negated sin negated] self > twopi  [(self \ twopi) sin] self > pi  [(self - pi) sin negated] self > halfpi  [(pi - self) sin] t1 _ self. t3 _ t1. t2 _ t1 * t1. for t4 from: (0.16666607 0.0083333315 1.98409e4 2.7525836e6 2.3899943e8 ) do [t1 _ t1 * t2. t3 _ t4 * t1 + t3]. t3] primitive: 202' classified: 'As yet unclassified'  Float understands: 'tan | t1 t2 t3 t4 [self < 0.0  [self negated tan negated] self > pi  [(self \ pi) tan] self > halfpi  [(self - halfpi) tan negated] self > fourthpi  [1.0 / (halfpi - self) tan] t1 _ self. t3 _ t1. t2 _ t1 * t1. for t4 from: (0.3333283 0.1333924 0.053373822 0.024564985 0.002900512 0.0095167197 ) do [t1 _ t1 * t2. t3 _ t4 * t1 + t3]. t3] primitive: 203' classified: 'As yet unclassified'  Float understands: 'arctan | t1 t2 t3 t4 t5 [self = 1.0  [45.0] self = 1.0  [45.0] [self * self > 1.0  [t1 _ halfpi. t3 _ 1.0 / (self * self). t2 _ 1.0 / self abs] t1 _ 0.0. t3 _ 0.0 - (self * self). t2 _ self abs]. t5 _ 1. t4 _ 9.9999884e5. while t2 abs > t4 do [t1 _ t1 + t2. t2 _ t2 * t3 * t5 asFloat / (t5 + 2) asFloat. t5 _ t5 + 2]. t1 _ self sign asFloat * t1 * 360.0 / twopi. t1] primitive: 204' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0027bring in fonts.st: -------------------------------------------------------------------------------- 1 | "Bring in fonts" | list indd. list _ ('Palatino09' 1 'Palatino14I' 2 'Palatino12' 3 'Palatino12B' 4 'Palatino14' 5 'Palatino16' 6 'Palatino16I' 7 'Palatino25' 8 'Palatino25B' 9 'NewYork10B' 10 'NewYork12B' 11). for indd from: 1 to: list length by: 2 do [ (DefaultTextStyle fontset)  (list(indd+1)) _ (Font new fromStrike: (listindd) stream: (user fileString: updateURL + (listindd + '.strike')) asStream)]. -------------------------------------------------------------------------------- /updates/0028inkrecognizer-yo.st: -------------------------------------------------------------------------------- 1 | D1Recognizer understands: 'start | a last current t [a _ Stream new of: (Vector new: 20). user waitnobug. last _ user waitbug. a next _ last. t _ Turtle new. t init. t penup. t goto: last. t pendn. while user redbug do [ current _ user mp. [last  current  [ a next _ current. t goto: current. last _ current]]]. user show: (self recognize: a contents) asString. user cr]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0029messageDict-bf.st: -------------------------------------------------------------------------------- 1 | 'set code to nil when deleting method' MessageDict understands: 'delete: selector | index [index _ self findorerror: selector. self freeMethod: methods  index. methods  index _ nil. [code  nil  [] code  index _ nil]. super delete: selector]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0030FileEdit-di.st: -------------------------------------------------------------------------------- 1 | 'Try user editFile: name' Class new title: FilePane subclassof: CodePane fields: 'fileName' declare: 'editmenu '; classified: 'Panes and Menus' FilePane understands: 'fileName: fName [fileName _ fName]' classified: 'As yet unclassified'  FilePane understands: 'compile: para [user fileString: fileName _ para text. user show: ''Saved '' + fileName.  true]' classified: 'As yet unclassified'  FilePane understands: 'fileName: fName [fileName _ fName]' classified: 'As yet unclassified'  FilePane derstands: compile:in:under:.  CodeWindow derstands: fileName:.  CodeWindow understands: 'file: fileName | pane [pane _ FilePane new fileName: fileName. self title: fileName with: pane inVector at: stdTemplates. self newframe. self show. pane showing: (user fileString: fileName) asParagraph. pane from: pane]' classified: 'As yet unclassified'  FilePane understands: 'compile: newPara [user fileString: fileName _ newPara text]' classified: 'As yet unclassified'  UserView understands: 'editFile: fileName [user schedule: (CodeWindow new file: fileName)]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0031reclassifyRecog-yo.st: -------------------------------------------------------------------------------- 1 | Class new title: D1Recognizer subclassof: Object fields: ' templates' declare: ''; classified: 'D1Recognizer' Class new title: D1Stream subclassof: Object fields: ' hot cool hotStart hotEnd coolStart coolEnd' declare: ''; classified: 'D1Recognizer' Class new title: D1Stroke subclassof: Object fields: ' name points' declare: ''; classified: 'D1Recognizer' -------------------------------------------------------------------------------- /updates/0035SundryFixes-di.st: -------------------------------------------------------------------------------- 1 | Generator understands: 'compile: para in: class under: category notifying: req | result [sourceParagraph _ para. requestor _ req. user displayoffwhile [sourceStream _ sourceParagraph asStream. result _ self compileIn: class. (result is: UniqueString)  false  [ false]. class organization classify: result under: category]. result]' classified: 'As yet unclassified'  Stream understands: 'peekFor: str | savePos i j [savePos _ position. for i to: str length do [self next  (stri) osition _ savePos.  false]].  true]' classified: 'As yet unclassified'  UserView understands: 'filoutChanges: chgs on: strm | class sel forget spec className [chgs empty  [chgs] chgs _ chgs asStream. until chgs end do [spec _ chgs next. user show: spec. spec _ spec asStream. [spec peekFor: ''+''  "Class def" [className _ spec rest unique. SmalltalkclassName printdefon: strm. strm next_ 30; cr]. forget _ spec peekFor: ''~''. "Method removal" class _ Smalltalk  (spec upto: 32) unique. sel _ (spec upto: 32) unique. forget lass printForget: sel on: strm] class printMethod: sel on: strm]. strm next_ 30; cr]]' classified: 'As yet unclassified'  Class understands: 'title: className subclassof: sup fields: fieldNames declare: classVarNames [className  1  (className  1) asUppercase  [user notify: ''Please capitalize each word in class title: '' + className. false] self title: className. self subclassof: sup. self fields: fieldNames. self declare: classVarNames. Changes insert: ''+'' + className]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0036allInstances-bf.st: -------------------------------------------------------------------------------- 1 | Class understands: 'allInstances [NoteTaker  [user notify: ''not implemented''] self allInstancesEver notNil] primitive: 100' classified: 'As yet unclassified'  Class understands: 'allInstancesEver | t1 t2 t3 t4 [NoteTaker  [user notify: ''not implemented''] t3 _ Vmem pclassesOf: self. t2 _ Vector new: 128 * t3 length. for t4 to: t3 length do [(t2  (t4 - 1 * 128 + 1 to: t4 * 128)) all_ t3  t4]. thisContext destroyAndReturn: (self fromFreelist: Class instsize fill: t2)] primitive: 100' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0037varInstances-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix allInstances for VariableLengthClass'  Class understands: 'allInstances [user croak] primitive: 100' classified: 'As yet unclassified'  Class understands: 'howMany [self allInstances length]' classified: 'As yet unclassified'  Class derstands: allInstancesEver.  VariableLengthClass derstands: allInstances.  VariableLengthClass derstands: allInstances:.  VariableLengthClass derstands: allInstancesEver:.  VariableLengthClass derstands: howMany:.  -------------------------------------------------------------------------------- /updates/0038moreResize-bf.st: -------------------------------------------------------------------------------- 1 | 'Make resizing more robust'  Window understands: 'outside [[titleframe window  nil  [] titleframe window has: user mp  [user anybug  [self editTitle] false]]. self repositionHotspot has: user mp + OriginCursor offset  [OriginCursor showwhile self reposition. false] self resizeHotspot has: user mp + CornerCursor offset  [CornerCursor showwhile self resize. false] false]' classified: 'As yet unclassified'  Window understands: 'reposition | rect [rect _ self repositionHotspot. until user anybug do [ (rect has: user mp)  false  [false]]. rect _ frame copy. frame boxcomp. until user nobug do [ frame origin  user mp  [ frame boxcomp. frame moveto: user mp. frame boxcomp]]. frame boxcomp. self frame: frame. user restore]' classified: 'As yet unclassified'  Window understands: 'repositionHotspot [frame origin - (1616) rect: frame origin]' classified: 'As yet unclassified'  Window understands: 'resize | rect [rect _ self resizeHotspot. until user anybug do [ (rect has: user mp)  false  [false]]. rect _ frame copy. frame boxcomp. until user nobug do [ frame corner  user mp  [ frame boxcomp. frame growto: user mp. frame boxcomp]]. frame boxcomp. self frame: frame. user restore]' classified: 'As yet unclassified'  Window understands: 'resizeHotspot [frame corner extent: 2424]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0039fixClass-bf.st: -------------------------------------------------------------------------------- 1 | 'Remove fieldtype from Class'  Class understands: 'bytesize: t1 [self  self realself  [self realself bytesize: t1] instsize _ (instsize land: 8191) + [t1 = 8  [0] 16384]]' classified: 'As yet unclassified'  Class understands: 'initClass [instsize _ self instvars length. instsize > 256  [user notify: ''too many instance variables''] instsize _ instsize + 1 * 2 + 8192. self organization]' classified: 'As yet unclassified'  Class understands: 'instsize [instsize allmask: 8192  [(instsize land: 2047) / 2 - 1] 0]' classified: 'As yet unclassified'  Class understands: 'printdefon: t1 | t2 [t1 append: self class title. t1 append: '' new title: ''. t1 append: title. t1 cr. t1 tab. t1 append: ''subclassof: '' + [superclass  nil  [''nil''] superclass title]. t1 cr. t1 tab. t1 append: ''fields: '' + myinstvars asString. t1 cr. t1 tab. t1 append: ''declare: ''''''. for t2 from: classvars contents do [t2 = ClassOrganization  [] t1 append: t2. t1 space]. t1 append: ''''''''. instsize nomask: 16384  [t1 semicrtab. t1 append: ''bytesize: ''. t1 print: (instsize anymask: 8192)] [SystemOrganization has: title  [ t1 semicrtab. t1 append: ''classified: ''; print: (SystemOrganization invert: title)]]. [environment  nil  [] for t2 from: environment do [t1 semicrtab. t1 append: ''sharing: '' + (Smalltalk invert: t2)]]. ]' classified: 'As yet unclassified'  "In Notetaker, Classes actually have only 7 inst vars" Class myinstvars_ 'title " for identification, printing" myinstvars " partnames for compiling, printing" instsize " for storage management" messagedict " for communication, compiling" classvars " compiler checks here" superclass " for execution of inherited behavior" environment " for external refs"'  -------------------------------------------------------------------------------- /updates/0040formEffects-bf.st: -------------------------------------------------------------------------------- 1 | 'Add effects (storing/oring/xoring/erasing) to FormWindow'  Class new title: FormWindow subclassof: Window fields: 'form effect' declare: 'actionMenu '; classified: 'Windows'  FormWindow understands: 'form: aForm [form _ aForm. effect _ storing. self newframe. self show]' classified: 'As yet unclassified'  FormWindow understands: 'show [form displayat: frame origin effect: effect clippedBy: user screenrect]' classified: 'As yet unclassified'  FormWindow understands: 'yellowbug | choice [choice _ (Menu new string: ''storing oring xoring erasing'') bug. choice = 0  [] effect _ choice - 1. user restore]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0041load-Logo24-font.st: -------------------------------------------------------------------------------- 1 | "Bring in fonts" | list indd. list _ ('Logo24' 12). for indd from: 1 to: list length by: 2 do [ (DefaultTextStyle fontset)  (list(indd+1)) _ (Font new fromStrike: (listindd) stream: (user fileString: updateURL + (listindd + '.strike')) asStream)]. -------------------------------------------------------------------------------- /updates/0042Reorganize-di.st: -------------------------------------------------------------------------------- 1 | 'Reorganizes the classes somewhat' UserView understands: 'reorganize "user reorganize." [SystemOrganization classify: FieldNameCollector under: ''Compiler''. SystemOrganization classify: TokenCollector under: ''Compiler''. SystemOrganization classify: Reader under: ''Compiler''. SystemOrganization classify: BitBlt under: ''Graphical Objects''. SystemOrganization classify: Form under: ''Graphical Objects''. SystemOrganization classify: Point under: ''Graphical Objects''. SystemOrganization classify: TextScanner under: ''Graphical Objects''. SystemOrganization classify: Rectangle under: ''Graphical Objects''. SystemOrganization classify: CharLine under: ''Text Objects''. SystemOrganization classify: TextImage under: ''Text Objects''. SystemOrganization classify: Font under: ''Text Objects''. SystemOrganization classify: FontSet under: ''Text Objects''. SystemOrganization classify: StyleSheet under: ''Text Objects''. SystemOrganization classify: D1Window under: ''Windows''. SystemOrganization deleteEmptyCategories. ]' classified: 'As yet unclassified'  user reorganize. UserView derstands: reorganize.  -------------------------------------------------------------------------------- /updates/0043LogoPatch-di.st: -------------------------------------------------------------------------------- 1 | 'Patch the Xerox logo - fasten seat belts'  | w ed loc . for w from: CodeWindow allInstances do [w'panes1' is: CodePane [ed _ (w'panes1')'pared'. loc _ ed para findString: 'XEROX' startingAt: 1. loc > 0  [ed replace: loc to: loc+4 with: ('XEROX' asParagraph allFont: 12)]]] -------------------------------------------------------------------------------- /updates/0044closeWindow-bf.st: -------------------------------------------------------------------------------- 1 | 'Restore display after closing window' Window understands: 'bluebug | t1 [t1 _ windowmenu bug. t1 = 1  [exitflag _ false. exitflag] t1 = 2  [self newframe. self enter] t1 = 3  [self close. self erase. user unschedule: self. user restore. false] t1 = 4  [self hardcopy] t1 = 5  [self print] t1 = 6  [self inspect]]' classified: 'As yet unclassified'  Window understands: 'newframe | pos rect [user waitnobug. [frame  nil  [] self aboutToFrame]. pos _ OriginCursor showwhile [user waitbug]. growing _ true. frame _ self fixframe: (pos rect: pos + 32). frame boxcomp. CornerCursor showwhile [while [pos _ user mpnext. pos] do [[rect  nil  [user cursorloc_ pos max: frame corner]]. rect _ frame copy. frame boxcomp. frame _ self fixframe: (frame growto: pos). frame boxcomp]]. frame boxcomp; outline. self frame: frame. growing _ false. self takeCursor]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0046lshiftFix-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix (124 lshift: 8)' LargeInteger understands: 'logicUnArg | t1 [bytes length  2  [user notify: ''not logic arg''] (bytes  2 land: 128)  0  [t1 _ (bytes  1 lxor: 255) + 1. bytes  1 _ t1 land: 255. t1 _ t1 lshift: 8. bytes  2 _ (bytes  2 lxor: 255) + t1 land: 255. neg _ true] self asInteger]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0047formInv-bf.st: -------------------------------------------------------------------------------- 1 | 'Add inverted display modes to form window' FormWindow understands: 'yellowbug | choices choice [choices _ (''dst _ src'' ''dst or src'' ''dst xor src'' ''dst and src'' ''dst _ ~src'' ''dst or ~src'' ''dst xor ~src'' ''dst and ~src'') copy. for choice to: 8 do [effect + 1 = choice  [choices  choice _ '' '' + (choices  choice) + '' '']]. choice _ (Menu new stringFromVector: choices) bug. choice = 0  [] effect _ choice - 1. user restore]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0049kbd.st: -------------------------------------------------------------------------------- 1 | TextImage understands: 'kbd | t1 t2 [c1 < c2 and self checklooks  [] t1 _ Set new string: 16. [begintypein  [] Deletion _ self selection. begintypein _ c1]. while [t2 _ user kbdnext. t2] do [t2 = bs  [t1 empty and [c1 = c2]  [c1 _ 1 max: c1 - 1. begintypein _ begintypein min: c1] [c1 = c2  [t1 skip: 1]]] t2 = cut  [self cut] t2 = paste  [self paste] t2 = ctlw  [[t1 empty  [] self replace: t1. t1 reset. c1 _ c2]. c1 _ 1 max: c1 - 1. while (c1 > 1 and (para  (c1 - 1)) tokenish) do [c1 _ c1 - 1]. begintypein _ begintypein min: c1] t2 = esc  [[t1 empty  [self unselect] self replace: t1. c1 _ c2]. self fintype. c1 _ c2 - Scrap length. self complement] t1 next_ t2]. self replace: t1. c1 _ c2. self selectAndScroll]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0050inspectFix-bf: -------------------------------------------------------------------------------- 1 | 'Fix user>>restartup: which is used by the inspector to open a new window, but did not actually restart the main loop' TextImage understands: 'kbd | t1 t2 [c1 < c2 and self checklooks  [] t1 _ Set new string: 16. [begintypein  [] Deletion _ self selection. begintypein _ c1]. while [t2 _ user kbdnext. t2] do [t2 = bs  [c1 < c2  [] "deleting selection happens below" t1 empty  [c1 _ 1 max: c1 - 1. begintypein _ begintypein min: c1] t1 skip: 1] t2 = cut  [self cut] t2 = paste  [self paste] t2 = ctlw  [[t1 empty  [] self replace: t1. t1 reset. c1 _ c2]. c1 _ 1 max: c1 - 1. while (c1 > 1 and (para  (c1 - 1)) tokenish) do [c1 _ c1 - 1]. begintypein _ begintypein min: c1] t2 = esc  [[t1 empty  [self unselect] self replace: t1. c1 _ c2]. self fintype. c1 _ c2 - Scrap length. self complement] t1 next_ t2]. self replace: t1. c1 _ c2. self selectAndScroll]' classified: 'As yet unclassified'  UserView understands: 'restartup: t1 [NormalCursor topage1. self schedule: t1. thisContext restart]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0051fixDelete-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix editor going whacky when deleting last char in a line' Textframe understands: 'replace: t1 to: t2 with: t3 | t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 [para replace: t1 to: t2 by: t3. lastline = 0  [self measureall. self displayall] t13 _ lines copy. t9 _ lastline. t7 _ self lineofchar: t1. t4 _ t7. t8 _ self lineofchar: t2. t11 _ t3 length - (t2 - t1 + 1). t14 _ (lines  t4) starti. [t7 > 1  [t10 _ self measurefrom: (lines  (t7 - 1)) starti to: para length. lines  (t7 - 1) = t10  [] t7 _ t7 - 1. self line: t7 _ t10. t14 _ t10 stopi + 1]]. [t14 > para length  [self trimLinesTo: (t4 - 1 max: 0). para length = 0  [window clear: white. self]]]. t12 _ false. t5 _ t8. until (t12 or t14 > para length) do [t10 _ self measurefrom: t14 to: para length. self line: t4 _ t10. until (t12 or (t5 > t9 or [t2 _ (t13  t5) stopi + t11. t10 stopi < t2])) do [t2 = t10 stopi  [t15 _ self yofline: t5 + [t11 < 0  [0] 1]. t16 _ self yofline: t4 + [t11 < 0  [0] 1]. t8 _ t4. t12 _ true. t17 _ t9. t5 _ t5 + 1. t6 _ t5 - 1. while [t6 _ 1 + t6. t17  t6] do [t4 _ t4 + 1. self line: t4 _ t13  t6 slide: t11]. self trimLinesTo: t4] t5 _ t5 + 1]. t14 _ t10 stopi + 1. t4 _ t4 + 1]. [t14 > para length  [t8 _ t4 min: lastline. self displaylines: t7 to: t8] (frame minX  t15 rect: window corner) blt: frame minX  t16 mode: storing. self displaylines: t7 to: t8. t16 < t15 and (self yofline: t9 + 1) > window maxY  [t8 _ self lineofy: window maxY. self displaylines: (self lineofy: window maxY - (t15 - t16)) to: t8]]. t8  lastline  [self clearfrom: (self yofline: lastline + 1)]]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0052clipText-bf.st: -------------------------------------------------------------------------------- 1 | 'clip text frame to window bounds' Textframe understands: 'replace: t1 to: t2 with: t3 | t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 [para replace: t1 to: t2 by: t3. lastline = 0  [self measureall. self displayall] t13 _ lines copy. t9 _ lastline. t7 _ self lineofchar: t1. t4 _ t7. t8 _ self lineofchar: t2. t11 _ t3 length - (t2 - t1 + 1). t14 _ (lines  t4) starti. [t7 > 1  [t10 _ self measurefrom: (lines  (t7 - 1)) starti to: para length. lines  (t7 - 1) = t10  [] t7 _ t7 - 1. self line: t7 _ t10. t14 _ t10 stopi + 1]]. [t14 > para length  [self trimLinesTo: (t4 - 1 max: 0). para length = 0  [window clear: white. self]]]. t12 _ false. t5 _ t8. until (t12 or t14 > para length) do [t10 _ self measurefrom: t14 to: para length. self line: t4 _ t10. until (t12 or (t5 > t9 or [t2 _ (t13  t5) stopi + t11. t10 stopi < t2])) do [t2 = t10 stopi  [t15 _ self yofline: t5 + [t11 < 0  [0] 1]. t16 _ self yofline: t4 + [t11 < 0  [0] 1]. t8 _ t4. t12 _ true. t17 _ t9. t5 _ t5 + 1. t6 _ t5 - 1. while [t6 _ 1 + t6. t17  t6] do [t4 _ t4 + 1. self line: t4 _ t13  t6 slide: t11]. self trimLinesTo: t4] t5 _ t5 + 1]. t14 _ t10 stopi + 1. t4 _ t4 + 1]. [t14 > para length  [t8 _ t4 min: lastline. self displaylines: t7 to: t8] (frame minX  t15 rect: window corner) blt: frame minX  t16 mode: storing clippedBy: window. self displaylines: t7 to: t8. t16 < t15 and (self yofline: t9 + 1) > window maxY  [t8 _ self lineofy: window maxY. self displaylines: (self lineofy: window maxY - (t15 - t16)) to: t8]]. t8  lastline  [self clearfrom: (self yofline: lastline + 1)]]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0055widetitlebar-yo.st: -------------------------------------------------------------------------------- 1 | Window understands: 'outside [[titleframe window  nil  [] titleframe window has: user mp  [user anybug  [self editTitle] false]. self titlebarframe has: user mp  [user redbug  [self titlebarclick]  false]]. self repositionHotspot has: user mp + OriginCursor offset  [OriginCursor showwhile self reposition. false] self resizeHotspot has: user mp + CornerCursor offset  [CornerCursor showwhile self resize. false] false]' classified: 'As yet unclassified'  Window understands: 'showtitle [[titlepara  nil  [titlepara _ Paragraph new text: self title runs: titlerun alignment: 0]]. titleframe put: titlepara at: frame origin + titleloc. self showtitlebar. titleframe put: titlepara at: frame origin + titleloc]' classified: 'As yet unclassified'  Window understands: 'showtitlebar | bar [bar _ self titlebarframe. bar clear: 0. bar outline] ' classified: 'As yet unclassified'  Window understands: 'titlebarclick []' classified: 'As yet unclassified'  Window understands: 'titlebarframe [ titleframe window origin rect: frame corner x  frame origin y]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0058largeIntPrims-bf.st: -------------------------------------------------------------------------------- 1 | 'Use new largeInt primitives for essential ops'  Integer understands: '+ other | otherint [other is: Integer  [self asLarge + other] otherint _ other asInteger. otherint isLarge  [self asLarge + other] self + otherint] primitive: 210' classified: 'As yet unclassified'  Integer understands: '- other | otherint [other is: Integer  [self asLarge - other] otherint _ other asInteger. otherint isLarge  [self asLarge - other] self - otherint] primitive: 211' classified: 'As yet unclassified'  LargeInteger understands: '+ other | otherneg result [otherneg _ other neg. neg  otherneg  [result _ bytes natadd: other bytes. LargeInteger new bytes: result neg: neg] result _ bytes natsubtract: other bytes. neg  [result negate] result] primitive: 210' classified: 'As yet unclassified'  LargeInteger understands: '- other | otherneg result [otherneg _ other neg. neg  otherneg  [result _ bytes natsubtract: other bytes. neg  [result neg_ result neg  false] result] result _ bytes natadd: other bytes. LargeInteger new bytes: result neg: neg] primitive: 211' classified: 'As yet unclassified'  LargeInteger understands: 'compare: other [((bytes length = 1 and bytes  1 = 0) and other bytes length = 1) and other bytes  1 = 0  [2] neg  [other neg  [other bytes natcompare: bytes] 1] other neg  [3] bytes natcompare: other bytes] primitive: 214' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0061menu-bf.st: -------------------------------------------------------------------------------- 1 | 'Keep menu on screen. Use new fbug in fileMenu'  Menu understands: 'fbug | result bits [bits _ self movingsetup. user waitbug. result _ self bugit. frame bitsFromString: bits. result]' classified: 'As yet unclassified'  Menu understands: 'movingsetup | offset delta bits [offset _ user mp - thisline center. frame moveby: offset. delta _ frame amountToTranslateWithin: user screenrect. frame moveby: delta. text frame moveby: offset + delta. thisline moveby: offset + delta. bits _ frame bitsIntoString. frame clear: black. text displayall. bits]' classified: 'As yet unclassified'  Rectangle understands: 'amountToTranslateWithin: aRectangle | dx dy "Answer a Point, delta, such that self + delta is forced within aRectangle." [dx _ dy _ 0. [self rightside > aRectangle rightside  [dx _ aRectangle rightside - self rightside]]. [self bottom > aRectangle bottom  [dy _ aRectangle bottom - self bottom]]. [(self leftside + dx) < aRectangle leftside  [dx _ aRectangle leftside - self leftside]]. [(self top + dy) < aRectangle top  [dy _ aRectangle top - self top]]. dxdy]' classified: 'As yet unclassified'  UserView understands: 'fileMenu: label directory: directory matching: match | fileNames index [fileNames _ user fileStrings: directory matching: match. index _ (Menu new stringFromVector: fileNames , ('' cancel '' + label + '' '')) fbug. index < 1 or index > fileNames length  [false] fileNames  index]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0063floatConstants-bf.st: -------------------------------------------------------------------------------- 1 | 'Higher-precision float constants'  Float understands: 'classInit [pi _ 3.141592653589793. halfpi _ pi / 2.0. fourthpi _ pi / 4.0. twopi _ pi * 2.0. radiansPerDegree _ pi / 180.0. degreesPerRadian _ 180.0 / pi. ln2 _ 0.693147180559945. sqrt2 _ 1.414213562373095]' classified: 'As yet unclassified'  Float classInit.  -------------------------------------------------------------------------------- /updates/0064revTitle2-yo.st: -------------------------------------------------------------------------------- 1 | Window understands: 'outside [[titleframe window  nil  [] titleframe window has: user mp  [user anybug  [self editTitle] false]]. self repositionHotspot has: user mp + OriginCursor offset  [OriginCursor showwhile self reposition. false] self resizeHotspot has: user mp + CornerCursor offset  [CornerCursor showwhile self resize. false] false]' classified: 'As yet unclassified'  Window understands: 'showtitle [[titlepara  nil  [titlepara _ Paragraph new text: self title runs: titlerun alignment: 0]]. titleframe put: titlepara at: frame origin + titleloc. titleframe window comp. titleframe outline]' classified: 'As yet unclassified'  Textframe derstands: put:reverseat:centered:.  Window derstands: showtitlebar.  Window derstands: titlebarclick.  Window derstands: titlebarframe.  -------------------------------------------------------------------------------- /updates/0065boldTitle-yo.st: -------------------------------------------------------------------------------- 1 | Window understands: 'editTitle | t1 t2 [t1 _ TextImage new para: titlepara frame: nil. t1 formerly: false. t1 fixframe: titleframe window + (1  2). t1 enter. t2 _ titleframe window. until (user anybug and (t2 has: user mp)  false) do [user kbck  [t1 typing] user redbug  [t2 has: user mp  [t1 selecting]] user yellowbug  [t2 has: user mp  [t2 flash]]]. titlepara _ t1 contents. titlepara allBold. self showtitle]' classified: 'As yet unclassified'  Window understands: 'showtitle [[titlepara  nil  [titlepara _ Paragraph new text: self title runs: titlerun alignment: 0]]. titleframe put: titlepara at: frame origin + titleloc. titleframe comp. titleframe outline]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0066TurtleChanges-di.st: -------------------------------------------------------------------------------- 1 | 'Adds a variable to FormWindow to capture screen bits. Examples in turtleTests.' Class new title: FormWindow subclassof: Window fields: 'form effect turtlemode' declare: 'actionMenu '; classified: 'Windows' FormWindow understands: 'turtlemode: trueforframeandcapture [turtlemode _ trueforframeandcapture]' classified: 'As yet unclassified'  FormWindow understands: 'turtleTests " 2 | Evaluate the top and bottom doits separately in order... | w . w _ FormWindow new. w form: (Form new extent: 300300); title_ ''Turtle''; turtlemode: true. user schedule: w. | pen i tw . tw _ user''Turtle''. tw enter. pen _ Turtle init: tw frame. pen color: black; width: 2; inking: oring. for i to: 100 do [pen go: i * 4; turn: 89. user displayFlush]. tw leave. "' classified: 'As yet unclassified'  FormWindow understands: 'show [[turtlemodetrueelf outline; showtitle]]. form displayat: frame origin effect: effect clippedBy: user screenrect]' classified: 'As yet unclassified'  FormWindow understands: 'leave [[turtlemodetrueelf captureDisplay]]. super leave]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0067editTitle1-yo.st: -------------------------------------------------------------------------------- 1 | Window understands: 'editTitle | text rect key [text _ TextImage new para: titlepara frame: nil. text formerly: false. text fixframe: titleframe window + (1  2). text enter. rect _ titleframe window. until (user anybug and (rect has: user mp)  false) do [(key _ user kbck)  [ [key  13  [text typing] true  [user kbdnext]]] user redbug  [rect has: user mp  [text selecting]] user yellowbug  [rect has: user mp  [rect flash]]]. titlepara _ text contents. titlepara allBold. self showtitle. user restore]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0068TurtleChanges2-di.st: -------------------------------------------------------------------------------- 1 | 'Adds some missing Turtle changes. Examples in turtleTests.' Turtle understands: 'home [location _ 00]' classified: 'As yet unclassified'  Turtle understands: 'init: rect [sourceraster _ 0. sourcebase _ sourceraster. super init. super toDisplay. self frame: rect. self clipTo: frame. self pendn. self color: black. self width: 1. self inking: storing. self home. self up]' classified: 'As yet unclassified'  FormWindow understands: 'captureDisplay | bb "Capture the bits of the display after edits or turtle drawing" [bb _ BitBlt new fromDisplay. bb destForm_ form. bb clipTo: (00 extent: form extent). bb bltrect: frame topt: 00 mode: storing color: nil]' classified: 'As yet unclassified'  Turtle understands: 'goto: pt | oldLoc origin [origin _ frame center. oldLoc _ location. location _ pt. pendown  [self drawfrom: oldLoc+origin to: location+origin] ]' classified: 'As yet unclassified'  Turtle understands: 'frame: rect [frame _ rect]' classified: 'As yet unclassified'  Turtle understands: 'init [self init: user screenrect]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0069fixUser-bf.st: -------------------------------------------------------------------------------- 1 | 'Get rid of obsolete UserView instances'  | u . for u from: user class allInstances do [u become: (UserView copy: u)]. -------------------------------------------------------------------------------- /updates/0071SafeKern-di.st: -------------------------------------------------------------------------------- 1 | 'Prevents lockup from excessive kerning.' TextScanner understands: 'scanword: lasti | ascii w [function _ 16. until chari > lasti do [ascii _ text  chari. exceptions  (ascii + 1)  0  [exceptions  (ascii + 1)] ascii < minascii or ascii > maxascii  [11] sourcex _ xtable  (ascii + 1). width _ xtable  (ascii + 2) - sourcex. [printing  [self callBLT]]. [kern > 0  [w _ width + charpad - kern. w < 2  [w _ 2]] w _ width + charpad]. destx _ destx + w. destx > stopx  [2] chari _ chari + 1]. chari _ chari - 1. 10] primitive: 50' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0072TurtleCleanup-di.st: -------------------------------------------------------------------------------- 1 | 'Turtle tests moved to Turtle.' Turtle understands: 'drawfrom: p1 to: p2 | offset delta dxsign dysign dyabs dxabs error i [[pen is: Integer  [function _ 12 + (function land: 3). height _ pen. width _ height. offset _ pen / 2  (pen / 2)] pen is: Form  [function _ function land: 3. super sourceForm_ pen. width _ pen width. height _ pen height. offset _ pen offset] user notify: ''pen must be a Form or Integer'']. destx _ (p1 x - offset x) asInteger. desty _ (p1 y - offset y) asInteger. delta _ (p2 x - p1 x) asInteger  (p2 y - p1 y) asInteger. dxsign _ delta x sign. dysign _ delta y sign. dyabs _ delta y abs. dxabs _ delta x abs. super callBLT. [dxabs > dyabs  [error _ dxabs / 2. for i to: dxabs do [destx _ destx + dxsign. error _ error - dyabs. [error < 0  [desty _ desty + dysign. error _ error + dxabs]]. super callBLT]] error _ dyabs / 2. for i to: dyabs do [desty _ desty + dysign. error _ error - dxabs. [error < 0  [destx _ destx + dxsign. error _ error + dyabs]]. super callBLT]]. pen is: Form  [super release: pen]]' classified: 'As yet unclassified'  Turtle understands: 'goto: pt | oldLoc origin [origin _ frame center. oldLoc _ location. location _ pt. pendown  [self drawfrom: oldLoc+origin to: location+origin. dest  DisplayForm  [user displayFlush]] ]' classified: 'As yet unclassified'  FormWindow derstands: turtleTests.  Turtle understands: 'turtleTests " Evaluate the top and bottom doits separately in order... | w . w _ FormWindow new. w form: (Form new extent: 300300); title_ ''Turtle''; turtlemode: true. user schedule: w. | pen i tw . tw _ user''Turtle''. tw enter. pen _ Turtle init: tw frame. pen color: black; width: 2; inking: oring. for i to: 100 do [pen go: i * 4; turn: 89]. tw leave. "' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0076BitRect-filin.st: -------------------------------------------------------------------------------- 1 | BitRect understands: 'filin: title | f i x y rect strips "read bits from a file" [f _ (user fileString: title+''.pic'') asStream. f end close. user notify: ''no data''] x_f nextword. y_f nextword. rect_Rectangle new origin: [origin is: Pointrigin] 00] extent: xy. self title: title in: rect. stripheightf nextwordser notify: ''strip heights dont match''] strips _ self strips. for i to: strips length do [f into: datai]. f close]' classified: 'as yet unclassified'. -------------------------------------------------------------------------------- /updates/0077turtleBatching-bf.st: -------------------------------------------------------------------------------- 1 | 'Add batching flag to Turtle and use it in Box to batch strokes'  Class new title: Turtle subclassof: BitBlt fields: 'frame location direction pen pendown inking batching' declare: ''; classified: 'Graphical Objects'  Box understands: 'init [ "Object understands: ''learn: code [(self class  Class [self] self class) understands: code]''. " location _ 0  0. size _ 100. tilt _ 0. pen _ Turtle init. pen width: 4. pen batch: true. self draw]' classified: 'As yet unclassified'  Turtle understands: 'batch: flag "If flag is false (the default) then each single stroke of the turtle will be visible. If true, consecutive strokes will appear simultaneaously." [batching _ flag  true  []. dest  DisplayForm  [user displayFlush]]' classified: 'As yet unclassified'  Turtle understands: 'goto: pt | oldLoc origin [origin _ frame center. oldLoc _ location. location _ pt. pendown  [self drawfrom: oldLoc+origin to: location+origin. batching  true  [] dest  DisplayForm  [user displayFlush]]]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0079BitRectTweaks2-di.st: -------------------------------------------------------------------------------- 1 | 'More fixes to BitRect classes' BitRectTool understands: 'draw [tone=white or tone=black [pencil place: self mpOnGrid. grid=1 "make drawing with grid 1 fast" [while user redbug do [pencil goto: user mp]] while user redbug do [pencil goto: self mpOnGrid]] self brush: graypenspencil width]' classified: 'As yet unclassified'  Turtle understands: 'goto: pt | oldLoc origin [oldLoc _ location. location _ pt. pendown  [self drawfrom: oldLoc to: location. batching  true  [] dest  DisplayForm  [user displayFlush]]]' classified: 'As yet unclassified'  Turtle understands: 'home [location _ frame center]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0080FormWindow.st: -------------------------------------------------------------------------------- 1 | FormWindow understands: 'form [form]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0082boxCoords-yo.st: -------------------------------------------------------------------------------- 1 | Box understands: 'init [ "Object understands: ''learn: code [(self class  Class [self] self class) understands: code]''. " location _ 0  0. size _ 100. tilt _ 0. pen _ Turtle init. pen width: 4. pen batch: true. self placeAt: location. self draw]' classified: 'As yet unclassified'  Box understands: 'moveTo: loc [self undraw. self placeAt: loc. self draw]' classified: 'As yet unclassified'  Box understands: 'placeAt: at [location _ at. pen penup; goto: at + (pen frame center); pendn; up]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0083backgroundForm-bf.st: -------------------------------------------------------------------------------- 1 | 'Allow a form to be used as background (will be tiled)'  Rectangle understands: 'color: color mode: mode [color is: Form  [self tile: color mode: mode] DisplayBLTer bltrect: self topt: origin mode: 12 + (mode land: 3) color: color]' classified: 'As yet unclassified'  Rectangle understands: 'fromuser | pos [origin _ OriginCursor showwhile [user waitbug]. corner _ pos _ origin + (1616). self boxcomp. CornerCursor showwhile [while [ self boxcomp. corner _ pos. self boxcomp. pos _ user mpnext] do [pos _ pos max: origin]]. self boxcomp]' classified: 'As yet unclassified'  Rectangle understands: 'tile: form mode: mode | blt left [blt _ BitBlt new toDisplay. blt function_ mode. blt sourceForm_ form. blt extent_ form extent. blt source_ 0  0. blt clipTo: self. blt dest_ origin / form extent * form extent. left _ blt destx. while blt desty < self bottom do [ while blt destx < self rightside do [blt callBLT; destx_ blt destx + form width] blt destx_ left. blt desty_ blt desty + form height]]' classified: 'As yet unclassified'  UserView understands: 'copyIn: project [UserView new screenrect: screenrect copy vtab: vtab htab: htab scale: scale color: ltgray projectWindow: project disp: disp sched: ()]' classified: 'As yet unclassified'  UserView understands: 'loadUpdates | allUpdates beforeLevel [beforeLevel _ updateLevel. allUpdates _ self updatesAvailable. while updateLevel < allUpdates length do [self filin: updateURL + (allUpdates  (updateLevel + 1)). updateLevel _ updateLevel + 1]. self cr; show: [beforeLevel = updateLevel  [''No''] (updateLevel - beforeLevel) asString]; show: '' new updates loaded. updateLevel '' + updateLevel asString; cr]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0084minorD1Opt-yo.st: -------------------------------------------------------------------------------- 1 | D1Stroke understands: 'lerp: a to: b at: ratio | ax ay bx by [ax _ a x asFloat. ay _ a y asFloat. bx _ b x asFloat. by _ b y asFloat.  Point new x: ax + ((bx - ax) * ratio) y: ay + ((by - ay) * ratio)]' classified: 'As yet unclassified'  D1Stroke understands: 'scale: ps to: s | bbExt bbx bby ss i newPoints p [bbExt _ (self encompassingRectangle: ps) extent. bbx _ bbExt x asFloat. bby _ bbExt y asFloat. ss _ s asFloat. newPoints _ Vector new: ps length. for i to: ps length do [p _ ps  i. newPoints  i _ p x * ss / bbx  (p y * ss / bby)]. newPoints]' classified: 'As yet unclassified'  D1Stroke derstands: add:to:beforeIndex:.  -------------------------------------------------------------------------------- /updates/0088user-bf.st: -------------------------------------------------------------------------------- 1 | 'Nicer update logging. Larger disp'  (user  'disp') frame_ 44 rect: 250195.  ProjectWindow understands: 'root [parent  self  [self] parent root]' classified: 'As yet unclassified'  UserView understands: 'filin: filename | file chunk result [file _ self fileString: filename. file  nil  [self cr; show: filename + '' is absent.''. nil] self cr; show: ''Reading '' + filename. file _ file asStream. FilinSource _ self. until file end do [chunk _ file upto: 30. result _ nil  chunk. "eval chunk" [result is: String  [self space; show: result] self show: ''.'']. file peek = 26  [file skipTo: ''\''  1. file skipTo: ''g''  1]]. self show: '' ''; cr. FilinSource _ nil]' classified: 'As yet unclassified'  UserView understands: 'loadUpdates | allUpdates beforeLevel beforeChanges [beforeLevel _ updateLevel. beforeChanges _ Changes copy. allUpdates _ self updatesAvailable. while updateLevel < allUpdates length do [self filin: updateURL + (allUpdates  (updateLevel + 1)). updateLevel _ updateLevel + 1]. Changes init copyfrom: beforeChanges. self cr; show: [beforeLevel = updateLevel  [''No''] (updateLevel - beforeLevel) asString]; show: '' new updates loaded. updateLevel '' + updateLevel asString; cr]' classified: 'As yet unclassified'  UserView understands: 'restore | i [kbMap _ NTkbMap. noupdate _ true. screenrect clear. for i from: sched length to: 1 by: 1 do [(schedi) enter]. [projectWindow  projectWindow root  [self show]]. noupdate _ false. self displayFlush]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0089asset-bf.st: -------------------------------------------------------------------------------- 1 | 'Provide user asset: and user asset:_'  UserView understands: 'asset: filename | file [[''http*'' match: filename  [] filename _ assetURL + filename]. file _ self fileString: filename. file  nil  [false]. Form new fromInstance: file asStream]' classified: 'As yet unclassified'  UserView understands: 'asset: filename _ form [[''http*'' match: filename  [] filename _ assetURL + filename]. self fileString: filename _ form asInstance. form]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0093ProjectSorterTweaks-di.st: -------------------------------------------------------------------------------- 1 | 'A few methods that got left out' ProjectPane understands: 'redbug | sel pane dragSel [sel _ ((self lineofy: user mp y) max: 1) - 1. list length < 2 or: sel = selection  [self select: 0.  user waitnobug] self select: sel. while (user anybug and (window has: user mp)) do [dragSel _ ((self lineofy: user mp y) max: 1) - 1. dragSel = sel or: dragSel = 0[]. [dragSel > sel "we just flip two entries at at time" [dragSel _ sel+1] dragSel _ sel-1]. list swap: sel with: dragSel. self of: list. sel _ dragSel. self select: sel] self compselection. self select: 0. sorter namesInOrder: list] ' classified: 'As yet unclassified'  ProjectSorter understands: 'allProjects | wins w [wins _ user allWindowsInAllProjects.  wins all w suchThat [w Is: ProjectWindow]]' classified: 'As yet unclassified'  ProjectSorter understands: 'classInit "ProjectSorter new classInit." [stdTemplates _ (0  0 rect: 36  36)]' classified: 'As yet unclassified'  ProjectWindow understands: 'parent [ parent]' classified: 'As yet unclassified'  UserView understands: 'rootUserview | pw [pw _ self projectWindow. pw parent  pw  [self]  pw parent userview]' classified: 'As yet unclassified'  ProjectSorter classInit  ProjectSorter classInit.  -------------------------------------------------------------------------------- /updates/0094misc-bf.st: -------------------------------------------------------------------------------- 1 | 'Show class def when selecting class. Add missing ProjectWindow userview getter. Show transcript on display restore, but only in root project.'  OrganizationPane understands: 'compile: parag | sel cat [classnil or selection1 [classPane compile: parag] "new definition" selection=2 [class organization fromParagraph: parag. self class: class] "new organization" cat _ [selection=0 [''As yet unclassified''] listselection]. sel _ selectorPane compile: parag in: class under: cat [self revise: (self listFor: class) with: cat. selection0 [selectorPane revise: (class organization category: cat) with: sel]] false]' classified: 'As yet unclassified'  OrganizationPane understands: 'noCode [class  nil  [classPane noCode] selection  1  [class definition] selection = 2  [class organization] ''Message name and Arguments | Temporary variables "short comment" ["long comment if necessary" Smalltalk Statements]'']' classified: 'As yet unclassified'  ProjectWindow understands: 'root [parent  self  [self] parent root]' classified: 'As yet unclassified'  ProjectWindow understands: 'userview [ userview]' classified: 'As yet unclassified'  Textframe understands: 'displayall | y save ["Kludge: globally clip to window. Should fix the drawing instead" save _ DisplayBLTer window. DisplayBLTer window: window. y _ self displaylines: 1 to: lastline. self clearfrom: y. DisplayBLTer window: save]' classified: 'As yet unclassified'  UserView understands: 'restore | i [kbMap _ NTkbMap. noupdate _ true. screenrect clear. for i from: sched length to: 1 by: 1 do [(schedi) enter]. [self  self rootUserview  [disp show]]. noupdate _ false. self displayFlush]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0096black-white-fix.st: -------------------------------------------------------------------------------- 1 | BitRectTool understands: 'blowup: smallRect to: bigRectFrame | bigRect box pt i turt flag bits [bits _ bigRectFrame bitsIntoString. bigRect _ bigRectFrame inset: 22. smallRect blowup: bigRect origin by: blowupScale. turt_Turtle init. box _ 00 rect: (blowupScale-1)(blowupScale-1). "keep editing in blowup mode until the user presses a button outside the big rect" while flag do [bigRect has: (pt _ user mp) [box moveto: bigRect origin + (i _ pt-bigRect origin|blowupScale). turt place: smallRect origin + (i/blowupScale). user redbugox color: black mode: storing. turt color: black; go: 0] user yellowbugox color: white mode: storing. turt color: white; go: 0] user bluebugigRect flash]] user anybug  [(bigRect inset: 55) has: ptigRect flash] "quit" flag_false]]. bigRectFrame bitsFromString: bits]' classified: 'as yet unclassified'. -------------------------------------------------------------------------------- /updates/0098moveByKeyboard-bf.st: -------------------------------------------------------------------------------- 1 | 'Move window by keyboard'  ListPane understands: 'eachtime [window has: user mp  [user kbck  [self kbd] [user anybug  [user redbug  [self redbug] user yellowbug  [self yellowbug] user bluebug  [false]]]]. self outside]' classified: 'As yet unclassified'  Window understands: 'reposition | rect [rect _ self repositionHotspot. "wait for user to click or use keyboard" until user anybug do [ user kbck  [ "pressed key, reframe by keyboard" frame boxcomp. until user anybug do [ user kbdnext = 193  [frame boxcomp; moveby: 10; boxcomp]; = 194  [frame boxcomp; moveby: 10; boxcomp]; = 195  [frame boxcomp; moveby: 01; boxcomp]; = 196  [frame boxcomp; moveby: 01; boxcomp];  false  [self frame: frame. user restore]]. frame boxcomp. user waitnobug]. (rect has: user mp)  false  [false]]. "clicked, reframe by mouse" rect _ frame copy. frame boxcomp. until user nobug do [ frame origin  user mp  [ frame boxcomp. frame moveto: user mp. frame boxcomp]]. frame boxcomp. self frame: frame. user restore]' classified: 'As yet unclassified'  ListPane derstands: keyset.  -------------------------------------------------------------------------------- /updates/0099shiftRecog-yo.st: -------------------------------------------------------------------------------- 1 | D1TextPane understands: 'recognize | a last current r [a _ Stream new of: (Vector new: 20). last _ user mp. a next _ last. pen penup. pen goto: last. pen pendn. while user redbug do [ current _ user mp. [last  current  [ a next _ current. pen goto: current. last _ current]]]. [a contents length > 1  [ r _ recognizer recognize: a contents. [(r  1) = ''line''  [self handleLineGesture: r stroke: a contents] self handleGesture: r stroke: a contents]] self handleClick: a contents  1]. self show]' classified: 'As yet unclassified'  D1TextPane understands: 'redbug | a last current r [(user keyset land: 1) = 1  [ self recognize].  super redbug] ' classified: 'As yet unclassified'  UserView understands: 'keyset | v [ (self primMouseKeys lshift: 3) land: 31]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0100keyset-bf.st: -------------------------------------------------------------------------------- 1 | 'Provide shiftKey, ctrlKey, metaKey in UserView. Decompile if shift pressed'  Class understands: 'code: sel [ "if shift key is down, decompile" user shiftKey  [self decompile: sel]. "last paragraph returned is cached (mainly for NotifyWindows)" [sel  lastSelector and self  lastClass  [] lastParagraph _ ([ sel = ClassOrganization  [self organization] (messagedict code: sel)  nil  [self decompile: sel] "Paragraph or RemoteParagraph" messagedict code: sel]) asParagraph. lastClass _ self. lastSelector _ sel]. lastParagraph]' classified: 'As yet unclassified'  UserView understands: 'ctrlKey [self keyset allmask: 2]' classified: 'As yet unclassified'  UserView understands: 'metaKey [self keyset allmask: 4]' classified: 'As yet unclassified'  UserView understands: 'shiftKey [self keyset allmask: 1]' classified: 'As yet unclassified'  UserView derstands: leftShiftKey.  -------------------------------------------------------------------------------- /updates/0101BadMethodSources-di.st: -------------------------------------------------------------------------------- 1 | 'Supplies source for a couple of methods that dont decompile correctly' Window understands: 'eachtime [frame has: user mp  [user kbck  [self kbd] user anybug  [user redbug  [self redbug] user yellowbug  [self yellowbug] user bluebug  [self bluebug]]. user anykeys  [self keyset]]. self outside  [] user anybug  [frame has: user mp  [] false] user kbck  [user kbd. frame flash]]' classified: 'As yet unclassified'  PanedWindow understands: 'eachtime | t1 [frame has: user mp  [user bluebug  [self bluebug] for t1 from: panes do [t1 startup]]. self outside  [] user anybug  [frame has: user mp  [] false] user kbck  [user kbd. frame flash]]' classified: 'As yet unclassified'  ListPane understands: 'eachtime [window has: user mp  [user kbck  [self kbd] user anybug  [user redbug  [self redbug] user yellowbug  [self yellowbug] user bluebug  [false]]]. self outside]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0104FixSubclasses-di.st: -------------------------------------------------------------------------------- 1 | 'Should now support adding instvars with subclasses in use' Class understands: 'fieldsString [myinstvars]' classified: 'As yet unclassified'  Class derstands: fields.  Class understands: 'declareString | t1 t2 [t1 _ Stream default. for t2 from: classvars contents do [t2 = ClassOrganization  [] t1 append: t2. t1 space]. t1 contents]' classified: 'As yet unclassified'  Class derstands: myinstvars.  Class understands: 'compileall | sel priorChanges " | c. for c from: user classNames do [c < ''Aa''[] c = CompiledMethod[] user cr; show: c. (Smalltalkc) compileall]. " [priorChanges _ Changes copy. for sel from: messagedict contents do [self understands: (self code: sel)]. Changes _ priorChanges. self  Object  [nil installError] MessageDict new freeMethods]' classified: 'As yet unclassified'  Class understands: 'fixSubClassesOf: oldClass | n subclass changeString [for n from: user classNames do [subclass _ Smalltalkn. subclass superclassoldClass [changeString _ ''+'' + subclass title. Class new title: subclass title subclassof: self fields: subclass fieldsString declare: subclass declareString. Changes has: changeString [Changes delete: changeString]]]]' classified: 'As yet unclassified'  Class derstands: copyof:subclassof:.  Class derstands: newFieldsForSubClass:.  -------------------------------------------------------------------------------- /updates/0105moveNicely-bf.st: -------------------------------------------------------------------------------- 1 | 'Restore display while moving windows by keyboard'  Window understands: 'reposition | rect [rect _ self repositionHotspot. "wait for user to click or use keyboard" until user anybug do [ user kbck  [ "pressed key, reframe by keyboard" frame boxcomp. until user anybug do [ user kbdnext = 193  [self frame: (frame moveby: 10). user restore. frame boxcomp]; = 194  [self frame: (frame moveby: 10). user restore. frame boxcomp]; = 195  [self frame: (frame moveby: 01). user restore. frame boxcomp]; = 196  [self frame: (frame moveby: 01). user restore. frame boxcomp];  false  [frame boxcomp]]. frame boxcomp. user waitnobug]. (rect has: user mp)  false  [false]]. "clicked, reframe by mouse" rect _ frame copy. frame boxcomp. until user nobug do [ frame origin  user mp  [ frame boxcomp. frame moveto: user mp. frame boxcomp]]. frame boxcomp. self frame: frame. user restore]' classified: 'As yet unclassified'  D1TextPane understands: 'eachtime [ user kbck [self kbd] frame has: user mp [ user shiftKey  [  self crossHairCursor showwhile [ while user shiftKey do [ user redbug  [self recognize]]]] user anybug [ user redbug [self redbug] user yellowbug [self yellowbug] user bluebug [false]] user anykeys [self keyset]] self outside]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0106FreeMethods-di.st: -------------------------------------------------------------------------------- 1 | 'Frees methods in MethodKeeper. Was not working before.' CompiledMethod understands: 'freeKeptMethods | t1 t2 [MethodKeeper _ (Vector new: 10) asStream]' classified: 'As yet unclassified'  MessageDict understands: 'freeMethods | t1 t2 [(CompiledMethod new: 2) freeKeptMethods]' classified: 'As yet unclassified'  MessageDict new freeMethods.  -------------------------------------------------------------------------------- /updates/0107updateGC-bf.st: -------------------------------------------------------------------------------- 1 | 'Force a GC after loading an update so the console shows a space report'  UserView understands: 'loadUpdates | allUpdates beforeLevel beforeChanges [Object allInstances. "force GC" beforeLevel _ updateLevel. beforeChanges _ Changes copy. allUpdates _ self updatesAvailable. while updateLevel < allUpdates length do [self filin: updateURL + (allUpdates  (updateLevel + 1)). updateLevel _ updateLevel + 1. Object allInstances "force GC"]. Changes init copyfrom: beforeChanges. self cr; show: [beforeLevel = updateLevel  [''No''] (updateLevel - beforeLevel) asString]; show: '' new updates loaded. updateLevel '' + updateLevel asString; cr]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0108MoreReshaping-di.st: -------------------------------------------------------------------------------- 1 | Class understands: 'fields: fieldString | r a b s h sel priorChanges [myinstvars _ fieldString. messagedict _ MessageDict init. r _ self realself. a _ self instvars. h_ HashSet init. for s from: a do [h has: s [user notify: s+'' is used already (maybe in superclass)''] h insert: s]. self=relf initClass] a=(b_ r instvars) [r environment_ nil; myinstvars_ myinstvars; subclassof: superclass] "The class is being reshaped..." user cr; show: ''Recompiling '' + title +''...''. [r howMany>0ser cr; show:''There will be obsolete instances'']]. classvars _ r classvars copy. messagedict _ MessageDict init. priorChanges _ Changes copy. for sel from: r messages do [self copy: sel from: r]. Changes _ priorChanges. self fixSubClassesOf: r. r obsolete. Smalltalktitle unique _ self. self initClass]' classified: 'As yet unclassified'  Class understands: 'noChanges | chg plusName className tildaName prefix [className _ self title. plusName _ ''+'' + className. tildaName _ ''~'' + className. for chg from: Changes contents do [prefix _ chg asStream upto: '' ''  1. prefix = className [Changes delete: chg] prefix = plusName [Changes delete: chg] prefix = tildaName [Changes delete: chg] ]]' classified: 'As yet unclassified'  Class understands: 'obsolete "Make it obvious that this class has been supplanted" [title _ ''AnObsolete''+title] ' classified: 'As yet unclassified'  Class derstands: removeFromChanges.  -------------------------------------------------------------------------------- /updates/0111misc-bf.st: -------------------------------------------------------------------------------- 1 | 'Flush method cache etc. Add senders menu'  MessageDict understands: 'primFlushMethodCache [] primitive: 103' classified: 'As yet unclassified'  MessageDict understands: 'freeMethod: m [m  nil  [] self primFlushMethodCache. NoteTaker  [(nil swap [m]) free] m refct > 2  [MethodKeeper next_ m] self rawLiteralsIn: m] ' classified: 'As yet unclassified'  MessageDict understands: 'swap: t1 with: t2 [methods swap: t1 with: t2. code swap: t1 with: t2. super swap: t1 with: t2]' classified: 'As yet unclassified'  SelectorPane understands: 'classInit [editmenu _ Menu new string: ''senders filout spawn forget'']' classified: 'As yet unclassified'  SelectorPane understands: 'yellowbug | [selection = 0  [window flash] scrollBar hidewhile [editmenu bug = 1  [user cr; show: ''senders of '' + (listselection); cr; show: (Smalltalk allCallsOn: listselection from: user classNames); cr; show: '''']; = 2  [organizationPane filout: list  selection]; = 3  [organizationPane spawn: list  selection with: codePane contents formerly: codePane oldContents]; = 4  [organizationPane forget: list  selection]]]' classified: 'As yet unclassified'  MessageDict derstands: killmethod:.  SelectorPane classInit  -------------------------------------------------------------------------------- /updates/0112noBorder-bf.st: -------------------------------------------------------------------------------- 1 | 'Remove border on CodePane too'  CodePane understands: 'outline [self style: noBorder  [frame clear: white] frame outline: 1]' classified: 'As yet unclassified'  PanedWindow understands: 'style: attr _ value | p [super style: attr _ value. attr  noBorder  [] for p from: panes do [ p class canUnderstand: ''style:_'' unique  [p style: attr _ value]]]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0115largeIntAt-yo.st: -------------------------------------------------------------------------------- 1 | LargeInteger understands: ' index | v [v _ bytes  index. neg  [ (((bytes  index) lxor: 255) + 1) land: 255].  v]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0116Helvetica-declare-tk.st: -------------------------------------------------------------------------------- 1 | "New text style" Smalltalk declare: HelveticaSet as: FontSet new init. Smalltalk declare: HelveticaStyle as: StyleSheet new. -------------------------------------------------------------------------------- /updates/0117Helvetica-load-tk.st: -------------------------------------------------------------------------------- 1 | "Bring in fonts" | list indd. list _ ('Helvetica11' 'Helvetica13' 'Helvetica14' 'Helvetica18' 'Helvetica25' 'Helvetica36' 'Helvetica48' ). for indd from: 1 to: list length do [ (HelveticaSet)  (indd-1) _ (Font new fromStrike: (listindd) stream: (user fileString: updateURL + (listindd + '.strike')) asStream)]. HelveticaStyle fontset: HelveticaSet. -------------------------------------------------------------------------------- /updates/0118TextFrame-style-tk.st: -------------------------------------------------------------------------------- 1 | Textframe understands: 'style: newStyle [style _ newStyle]' classified: 'as yet unclassified'. -------------------------------------------------------------------------------- /updates/0119newRecogCursor.st: -------------------------------------------------------------------------------- 1 | D1TextPane understands: 'handleLineGesture: r stroke: ps | startX one two theta [startX _ (ps  1) x. theta _ r  2. [(1.50 < theta and [theta < 1.64])  [ one _ pared frame origin x + ((pared frame extent x) / 3). two _ pared frame origin x + (((pared frame extent x) / 3) * 2). [origFrame origin x < startX and [startX < one]  [pared alignment _ 1] one  startX and [startX < two]  [pared alignment _ 2] two  startX and [startX  pared frame corner x]  [pared alignment _ 4]]] (1.65 < theta and [theta < 2.2])  [ pared c1_ 1. pared c2_ pared text length + 1. pared leave. pared enter]]]' classified: 'As yet unclassified'  D1TextPane understands: 'handleClick: p [pared select: (pared charofpoint: p). self show] ' classified: 'As yet unclassified'  D1TextPane understands: 'crossHairCursor [CrossHairCursor  nil  [CrossHairCursor] CrossHairCursor _ (Cursor new fromtext: '' 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000110000000 0000001111000000 0000011111100000 0000111111110000 0000111111110000 0000011111100000 0000001111000000 0000000110000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 '' offset: 8  8) beNTCursor. CrossHairCursor]' classified: 'As yet unclassified'  D1TextPane new clearCursor -------------------------------------------------------------------------------- /updates/0121D1PathDistancePrim-yo.st: -------------------------------------------------------------------------------- 1 | D1Recognizer understands: 'pathDistance: a from: b for: t | ai bi d i [d _ 0.0. for i to: a length do [ai _ a  i. bi _ b  i. d _ d + (t dist: ai and: bi)]. d / a length asFloat] primitive: 240' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0122fixCursors-bf.st: -------------------------------------------------------------------------------- 1 | 'Unscramble NT cursors'  | c . NormalCursor bits  1  0  [] for c from: Cursor allInstances do [c beAltoCursor]  D1TextPane understands: 'crossHairCursor [CrossHairCursor  nil  [CrossHairCursor] CrossHairCursor _ (Cursor new fromtext: '' 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000110000000 0000001111000000 0000011111100000 0000111111110000 0000111111110000 0000011111100000 0000001111000000 0000000110000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 '' offset: 8  8). CrossHairCursor]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0123cachePointsInD1-yo.st: -------------------------------------------------------------------------------- 1 | Class new title: D1Recognizer subclassof: Object fields: ' templates pointsCache' declare: ''; classified: 'D1Recognizer' D1Recognizer understands: 'distance: stroke from: t atAngle: theta | newPoints [[(newPoints _ pointsCache lookup: theta asString) = false  [ newPoints _ stroke rotate: stroke points by: theta. pointsCache insert: theta asString with: newPoints]].  self pathDistance: newPoints from: t points for: stroke]' classified: 'As yet unclassified'  D1Recognizer understands: 'recognize: ps | stroke theta [stroke _ D1Stroke new points: ps. stroke preProcess. pointsCache _ Dictionary new: 10. [stroke isLong  [ theta _ stroke theta: (Point new x: (ps last x asFloat - (ps  1) x asFloat) y: (ps last y asFloat - (ps  1) y asFloat)).  ''line'', theta]]. self recognize: stroke against: templates in: 250.0]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0124D1select-yo.st: -------------------------------------------------------------------------------- 1 | D1TextPane understands: 'handleClick: p [pared select: (pared charofpoint: p)] ' classified: 'As yet unclassified'  D1TextPane understands: 'handleLineGesture: r stroke: ps | startX one two theta [startX _ (ps  1) x. theta _ r  2. [(1.50 < theta and [theta < 1.64])  [ one _ pared frame origin x + ((pared frame extent x) / 3). two _ pared frame origin x + (((pared frame extent x) / 3) * 2). [origFrame origin x < startX and [startX < one]  [pared alignment _ 1] one  startX and [startX < two]  [pared alignment _ 2] two  startX and [startX  pared frame corner x]  [pared alignment _ 4]]] (1.65 < theta and [theta < 2.2])  [ pared c1_ 1. pared c2_ pared text length + 1]]]' classified: 'As yet unclassified'  D1TextPane understands: 'recognize | a last current r [a _ Stream new of: (Vector new: 20). last _ user mp. a next _ last. pen penup. pen goto: last. pen pendn. while user redbug do [ current _ user mp. [last  current  [ a next _ current. pen goto: current. last _ current]]]. [a contents length > 1  [ r _ recognizer recognize: a contents. [(r  1) = ''line''  [self handleLineGesture: r stroke: a contents] self handleGesture: r stroke: a contents]] self handleClick: a contents  1]. self show]' classified: 'As yet unclassified'  D1TextPane understands: 'show | r f c [super show. f _ pared frame intersect: origFrame. c _ f origin x  f corner y. r _ (f origin + (3 negated  0)) rect: (c + (2 negated  0)). r clear: gray. c _ f corner x  f origin y. r _ (c + (2  0)) rect: (f corner + (3  0)). r clear: gray. pared show. pared select] ' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0126hideScrollbar-bf.st: -------------------------------------------------------------------------------- 1 | 'Hide scrollbar if no title and text fits'  CodePane understands: 'enter [(self style: noTitle) and ((frame has: pared frame origin) and pared height  frame height)  [] scrollBar show] ' classified: 'As yet unclassified'  CodePane understands: 'leave [scrollBar showing  [scrollBar hide]]' classified: 'As yet unclassified'  CodePane understands: 'yellowbug [editmenu bug = 1  [pared again]; = 2  [pared copyselection]; = 3  [pared cut]; = 4  [pared paste]; = 5  [self doit]; = 6  [pared formerly  [selectorPane compile: pared contents  [pared formerly: false]] frame flash]; = 7  [pared undo]; = 8  [pared formerly  [self showing: pared formerly] frame flash]; = 9  [pared realign]]' classified: 'As yet unclassified'  ScrollBar understands: 'showing [bitstr  nil]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0127windowLeave-bf.st: -------------------------------------------------------------------------------- 1 | 'Pair enter/leave in display restore'  CodePane understands: 'outside [scrollBar showing  [scrollBar startup] false]' classified: 'As yet unclassified'  PanedWindow understands: 'leave | p [for p from: panes do [p windowleave]. super leave]' classified: 'As yet unclassified'  UserView understands: 'restore | i [kbMap _ NTkbMap. noupdate _ true. screenrect clear. (sched1) leave. for i from: sched length to: 2 by: 1 do [(schedi) enter; leave]. (sched1) enter. [self  self rootUserview  [disp show]]. noupdate _ false. self displayFlush]' classified: 'As yet unclassified'  Window understands: 'leave [style  nil  [frame border: 1 color: gray]]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0128windowClose-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix gribblies on window close'  Rectangle understands: 'border: w color: color [self border: w color: color mode: storing]' classified: 'As yet unclassified'  Rectangle understands: 'border: w color: color mode: mode| r [r _ Rectangle new origin: origin - (w  w) corner: corner x + w  origin y. r color: color mode: mode. r moveto: origin x - w  corner y. r color: color mode: mode. r origin_ corner x  (origin y - w). r color: color mode: mode. r moveto: origin - (w  w). r color: color mode: mode]' classified: 'As yet unclassified'  Rectangle understands: 'clear: fill border: w color: color mode: mode | r [[w > 0  [self border: w color: color mode: mode]]. fill  nil  [self color: fill mode: mode]]' classified: 'As yet unclassified'  Window understands: 'bluebug [windowmenu bug =1[exitflag _ false]; =2elf newframe; enter]; =3elf close. user unschedule: self. user restore. self leave. false]; =4elf style: noTitle _ (self style: noTitle)  false. user restore]; =5elf styleEdit]; =6elf hardcopy]; =7elf print]; =8 [self inspect]]' classified: 'As yet unclassified'  Window understands: 'leave [style  nil  [frame border: 1 color: gray mode: xoring]]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0129fixNTkbMap-bf.st: -------------------------------------------------------------------------------- 1 | 'Add ctl-2 to NTkbMap'  NTkbMap3 _ 144.  TextImage understands: 'checklooks | t val mask [ "see ParagraphEditor checklooks. substitute c1 for loc1, c2 for loc2, oldEntity for oldpara, entity for para" t _ (166 150 137 151 230 214 201 215 135 159 144 143 128 127 129 131 180 149 199 223 208 207 192 191 240 226) find: user kbck. t=0[false] user kbd. t=25elf toBravo]; "ctl-T" =26elf fromBravo]. "ctl-F" val _ (1 2 4 256 1 2 4 256 "ctl-b i - x B I  X" 0 16 32 48 64 80 96 112 128 144 "ctl-0 1 ... 9" 160 176 192 208 224 240)t. "ctl-shift-0 1 ... 5" [val=256ask_ 0377. val_ 0] "reset all" val<0ask_ 0-val. val_ 0] "reset emphasis" val>0 and val<16ask_ val] "set emphasis" mask_ 0360]. "set font" para maskrun: c1 to: c2-1 under: mask to: val. [mask = 0360  [self replace: c1 to: c2 - 1 with: (para copy: c1 to: c2 - 1)] self displaylines: (self lineofchar: c1) to: (self lineofchar: c2)]. self select]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0132filout-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix deleting method in filout'  Class understands: 'printForget: sel on: stream [stream append: self title; append: '' derstands: ''; print: sel asString; append: '' unique.''; cr]' classified: 'As yet unclassified'  Class understands: 'printMethod: sel on: stream | cat code [cat _ self organization invert: sel. code _ self code: sel. [code is: Paragraph  [code _ code text]]. stream append: self title + '' understands: ''; print: code; append: '' classified: ''; print: cat; cr]' classified: 'As yet unclassified'  PanedWindow understands: 'enter | p [super show. for p from: panes do [p windowenter]]' classified: 'As yet unclassified'  PanedWindow understands: 'show | p [super show. for p from: panes do [p outline]]' classified: 'As yet unclassified'  UserView understands: 'filoutChanges: chgs on: strm | class sel forget spec className postscript [chgs empty  [chgs] postscript _ Stream default. chgs _ chgs asStream. until chgs end do [spec _ chgs next. user cr; show: spec. spec _ spec asStream. [spec peekFor: ''+''  "Class def" [className _ spec rest unique. SmalltalkclassName printdefon: strm]. forget _ spec peekFor: ''~''. "Method removal" class _ Smalltalk  (spec upto: 32) unique. sel _ (spec upto: 32) unique. forget lass printForget: sel on: strm] class printMethod: sel on: strm. sel = classInit  [postscript append: class title; space; append: sel; cr; next_ 30; cr]]. strm next_ 30; cr]. strm append: postscript contents]' classified: 'As yet unclassified'  -------------------------------------------------------------------------------- /updates/0134arrange-fonts-tk.st: -------------------------------------------------------------------------------- 1 | "move fonts around in the DefaultTextStyle" "Warning -- fonts will be messed up if this change is executed more than once in the same image!" (DefaultTextStyle fontset)  1 _ (DefaultTextStyle fontset)  3. (DefaultTextStyle fontset)  2 _ (DefaultTextStyle fontset)  4. (DefaultTextStyle fontset)  3 _ (DefaultTextStyle fontset)  5. (DefaultTextStyle fontset)  4 _ (DefaultTextStyle fontset)  6. (DefaultTextStyle fontset)  5 _ (DefaultTextStyle fontset)  7. (DefaultTextStyle fontset)  6 _ (DefaultTextStyle fontset)  8. (DefaultTextStyle fontset)  7 _ (DefaultTextStyle fontset)  9. (DefaultTextStyle fontset)  8 _ HelveticaSet  0. (DefaultTextStyle fontset)  9 _ HelveticaSet  1. (DefaultTextStyle fontset)  10 _ HelveticaSet  2. (DefaultTextStyle fontset)  11 _ HelveticaSet  3. "font 12 is Logo24 and is unchanged" (DefaultTextStyle fontset)  13 _ HelveticaSet  4. (DefaultTextStyle fontset)  14 _ HelveticaSet  5. (DefaultTextStyle fontset)  15 _ HelveticaSet  6. -------------------------------------------------------------------------------- /updates/0135ST72Font-declare-tk.st: -------------------------------------------------------------------------------- 1 | "New text style" Smalltalk declare: ST72FontSet as: FontSet new init. Smalltalk declare: ST72FontStyle as: StyleSheet new. -------------------------------------------------------------------------------- /updates/0136ST72Font-load-tk.st: -------------------------------------------------------------------------------- 1 | "Bring in fonts" | list indd. list _ ('ST72Font10' ). for indd from: 1 to: list length do [ (ST72FontSet)  (indd-1) _ (Font new fromStrike: (listindd) stream: (user fileString: updateURL + (listindd + '.strike')) asStream)]. ST72FontStyle fontset: ST72FontSet. -------------------------------------------------------------------------------- /updates/0139fontIncDec-bf.st: -------------------------------------------------------------------------------- 1 | 'Use Cmd -/+ to choose prev/next font'  TextImage understands: 'checklooks | t val mask cur [ "see ParagraphEditor checklooks. substitute c1 for loc1, c2 for loc2, oldEntity for oldpara, entity for para" t _ (166 150 137 151 230 214 201 215 135 159 144 143 128 127 129 131 180 149 199 223 208 207 192 191 228 229) find: user kbck. t=0[false] user kbd. val _ (1 2 4 256 1 2 4 256 "ctl-b i - x B I  X" 0 16 32 48 64 80 96 112 128 144 "ctl-0 1 ... 9" 160 176 192 208 224 240 01F0H 0110H)t. "ctl-shift-0 1 ... 5" [val=256ask_ 0377. val_ 0] "reset all" val<0ask_ 0-val. val_ 0] "reset emphasis" val>0 and val<16ask_ val] "set emphasis" mask_ 0360. "set font" val > 240  [val _ (para runAndVal: c1)2 + val]]. "inc/dec font" para maskrun: c1 to: c2-1 under: mask to: val. [mask = 0360  [self replace: c1 to: c2 - 1 with: (para copy: c1 to: c2 - 1)] self displaylines: (self lineofchar: c1) to: (self lineofchar: c2)]. self select]'  -------------------------------------------------------------------------------- /updates/0140doitInTablet-yo.st: -------------------------------------------------------------------------------- 1 | D1TextPane understands: 'doit | sel value strm [scrollBar hidewhile [sel _ pared selectRange. [sel empty  [pared unselect. pared fintype. pared complement. sel _ pared selectRange]]. value _ self execute: pared selectionAsStream in: false to: nil. [value  nil or sel  pared selectRange  [nil] sel _ sel stop + 1. strm _ (String new: 100) asStream. strm space. strm print: value. pared selectRange: (sel to: sel). pared paste: strm contents]]]'  -------------------------------------------------------------------------------- /updates/0143fullTitleFrame-bf.st: -------------------------------------------------------------------------------- 1 | 'Protect against nil titleframe window'  Window understands: 'fullTitleFrame | rect [self style: noTitle  [frame origin rect: frame origin] [self  user topWindow  [rect _ titleframe window]]. [rect  nil  [rect _ frame origin - titleloc rect: frame maxXframe minY]]. rect inset: 22]'  -------------------------------------------------------------------------------- /updates/0144titleFrameAgain-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix fullTitleFrame for real'  Window understands: 'fullTitleFrame | rect [self style: noTitle  [frame origin rect: frame origin] rect _ frame origin + (0(titleloc y - 2)) rect: frame maxX(frame minY-4). [self  user topWindow and nil  titleframe window  [rect _ rect include: titleframe window]]. rect inset: 22]'  -------------------------------------------------------------------------------- /updates/0145ToolpicEtc-di.st: -------------------------------------------------------------------------------- 1 | BitRect understands: 'filout | strm "store in asset directory" [strm _ Stream default. self filoutOn: strm. user fileString: updateURL + title + ''.pic'' _ strm contents]'  BitRect understands: 'filoutOn: f | i "write bits on a file or stream" [f nextword _ self extent x. f nextword _ self extent y. f nextword _ stripheight. for i from: data do [f append: i]. ]'  BitRect understands: 'title: str in: rect | nStrips i strips [title _ str. origin_rect origin. corner_rect corner. "the strip height is chosen so that each bitstring is about 2048 bytes" stripheight_1023/((self extent x + 15)/16). nStrips_(self extent y+stripheight-1)/stripheight. data_Vector new: nStrips. strips_self strips. for i to: nStrips do [datai_String new: (stripsi) bitStringLength]]'  BitRectEditor understands: 'classInit | t i "BitRectEditor classInit." [t _ Vector new: 6. for i to: t length do [ti _ BitRectTool new init]. tools _ (RadioButtons new) vec: t at: 00 width: 20. windowmenu _ Menu new string: ''under move grow close filout printbits inspect inspect tool inspect pencil''. actionpic_ BitRect new filin: updateURL + ''actionpic''. toolpic_ BitRect new filin: updateURL + ''toolpic''. " user fileString: updateURL + ''toolpic''" " toolpic_ BitRect new filin: updateURL + ''toolpic''. 2 | " " (Form new extent: 20120) white displayat: 00 effect: storing. toolpic_BitRect new title: ''toolpicnot'' in: (00 rect: 20120). toolpic saveScreenBits." self initmenu1]'  BitRectTool understands: 'line | start end saveMode [start_end_self mpOnGrid. saveMode _ pencil function. pencil width: [penwidth  nil[2] penwidth]; color: black; inking: xoring. while user redbug do [end_self mpOnGrid. pencil place: start; goto: end; place: start; goto: end]. pencil color: tone; inking: mode; place: start; goto: end]'  BitRectEditor classInit  -------------------------------------------------------------------------------- /updates/0147Sequencer.st: -------------------------------------------------------------------------------- 1 | Class new title: Sequencer subclassof: FormWindow fields: 'count' declare: ''; classified: 'Project Sequencing'  Sequencer understands: 'next [ count _ count + 1. self sequence. ]'  Sequencer understands: 'delay | jj [ for jj from: 1 to: 10000 do [jj]. ]'  Sequencer understands: 'redbug [ user waitnobug  [self next]. ]'  Sequencer understands: 'sequence ["expects actual content from a subclass (acting as a uniclass for each Project)" count = 1  []. count = 2  []. count > 2  [self resetSeq. frame flash]. ]'  Sequencer understands: 'resetSeq ["expects actual content from a subclass (acting as a uniclass for each Project)" count _ 0. "here: put back the initial conditions of this Project" ]'  Sequencer understands: 'initSeq [ self style: noTitle _ true. self style: noBorder _ true. form _ (Form new extent: 5050) gray. effect _ storing. self frame: (900700 extent: form extent). self show. user schedule: self. user restore. count _ 0. ]'  -------------------------------------------------------------------------------- /updates/0148CalendarPage.st: -------------------------------------------------------------------------------- 1 | Class new title: CalendarPage subclassof: FormWindow fields: 'page loc cache ' declare: ''; classified: 'Graphical Objects'  CalendarPage understands: 'delay | ii [ for ii from: 1 to: 10000 do [ii]. ]'  CalendarPage understands: 'initFlyaway: aForm at: position [ page _ aForm. self style: noTitle _ true. self style: noBorder _ true. form _ aForm. effect _ storing. self frame: (position extent: form extent). cache _ DisplayForm copy: self frame. self show. user schedule: self. user restore. loc _ frame copy. ]'  CalendarPage understands: 'redbug [ user waitnobug  [self flyaway] ]'  CalendarPage understands: 'classComment [ "do this to get an initialize instance:" Smalltalk declare: cal as: (CalendarPage new initFlyaway: (user asset: ''2010s.form'')). ]'  CalendarPage understands: 'initFlyaway: aForm [ self style: noTitle _ true. self style: noBorder _ true. self form: aForm. user schedule: self. user restore. loc _ frame copy. ]'  CalendarPage understands: 'resetInit [ self frame: loc copy. cache _ DisplayForm copy: self frame. self show. "user displayFlush." user restore. ]'  CalendarPage understands: 'flyaway [ loc _ frame copy. "remember this for reset" until (frame origin y) > 768 do [ "put back cache." cache displayat: frame origin. "move frame" self frame: (frame moveby: 1010). "recache" cache _ DisplayForm copy: self frame. "now show" self show. user displayFlush. "user restore." ]. ]'  -------------------------------------------------------------------------------- /updates/0150arrowMove-bf.st: -------------------------------------------------------------------------------- 1 | 'Improve dragging arrow ends'  ArrowWindow understands: 'crossHairCursor [CrossHairCursor  nil  [CrossHairCursor] CrossHairCursor _ (Cursor new fromtext: '' 0000001111000000 0000001111000000 0000001111000000 0000001111000000 0000001111000000 0000001111000000 1111110000111111 1111110000111111 1111110000111111 1111110000111111 0000001111000000 0000001111000000 0000001111000000 0000001111000000 0000001111000000 0000001111000000 '' offset: 0  0). CrossHairCursor]'  ArrowWindow understands: 'eachtime [(self pointHotspot: stylebeginPoint) has: user mp  [self crossHairCursor showwhile [self pointMove: beginPoint]. true]. (self pointHotspot: styleendPoint) has: user mp  [self crossHairCursor showwhile [self pointMove: endPoint]. true]. super eachtime]'  ArrowWindow understands: 'outside [false]'  ArrowWindow understands: 'pointHotspot: pt [pt asRectangle inset: 1010]'  ArrowWindow understands: 'pointMove: whichPt | hotspot [hotspot _ self pointHotspot: stylewhichPt. until user anybug do [(hotspot has: user mp)  false  [false]]. self restore; draw: xoring. while user anybug do [ self draw: xoring. style  whichPt _ user mp. self draw: xoring. ]. self draw: xoring. self frame: (Rectangle new encompass: self beginPoint, self endPoint). self show] '  ArrowWindow understands: 'show [self draw: storing]'  ArrowWindow new clearCursor.  -------------------------------------------------------------------------------- /updates/0151moreArrow-bf.st: -------------------------------------------------------------------------------- 1 | ArrowWindow understands: 'default | pt [self crossHairCursor showwhile [pt _ user waitbug]. self style: beginPoint _ pt. self style: endPoint _ pt. self style: hasHead _ true. frame _ (pt rect: pt) inset: 2020. self pointMove: endPoint]'  ArrowWindow understands: 'enter [self show]'  ArrowWindow understands: 'pointMove: whichPt | hotspot [hotspot _ self pointHotspot: stylewhichPt. until user anybug do [(hotspot has: user mp)  false  [false]]. self restore; draw: xoring. while user anybug do [ self draw: xoring. style  whichPt _ user mp. self draw: xoring. ]. self draw: xoring. self frame: ((Rectangle new encompass: self beginPoint, self endPoint) inset: 2020). self show] '  ArrowWindow derstands: 'eachtimeOld' unique.  -------------------------------------------------------------------------------- /updates/0152arrowWindow2-yo.st: -------------------------------------------------------------------------------- 1 | ArrowWindow understands: 'draw: function | t [t _ Turtle init. [nil  function  [t function_ function]]. t width: (self style: borderWidth). t color: (self style: borderColor). t color: black. t place: self beginPoint. t goto: self endPoint. self hasHead  [ t up. t turn: ((self endPoint - self beginPoint) theta / 3.1415926 * 180.0) + 90.0. t turn: 157. t go: 20. t penup. t turn: 180. t go: 20. t pendn. t turn: 23. t turn: 157 negated. t go: 20]]'  ArrowWindow understands: 'pointMove: whichPt | hotspot current prev other [hotspot _ self pointHotspot: stylewhichPt. until user anybug do [(hotspot has: user mp)  false  [false]]. self restore; draw: xoring. while user anybug do [ current _ user mp. [user shiftKey  [ [whichPt = beginPoint  [ other _ style  endPoint] other _ style  beginPoint]. [(other x - current x) abs > (other y - current y) abs  [ current _ current x  other y] current _ other x  current y]]]. [prev  current  [self draw: xoring. style  whichPt _ current. self draw: xoring. prev _ current]]. ]. self draw: xoring. self frame: ((Rectangle new encompass: self beginPoint, self endPoint) inset: 2020). self show] '  Point understands: 'theta | theta tan [ [x = 0  [y  0  [1.5707963] 4.712389]]. tan _ y asFloat / x asFloat. theta _ tan arctan. [x  0  [y  0  [theta] true  [ 6.2831853 + theta]]].  3.1415927 + theta]'  -------------------------------------------------------------------------------- /updates/0153arrowWindow3-yo.st: -------------------------------------------------------------------------------- 1 | ArrowWindow understands: 'draw: function | t [t _ Turtle init. [nil  function  [t function_ function]]. t width: (self style: borderWidth). t color: (self style: borderColor). t place: self beginPoint. t goto: self endPoint. self hasHead  [ t up. t turn: ((self endPoint - self beginPoint) theta / 3.1415926 * 180.0) + 90.0. t turn: 157. t go: 20. t penup. t turn: 180. t go: 20. t pendn. t turn: 23. t turn: 157 negated. t go: 20]]'  -------------------------------------------------------------------------------- /updates/0154ParcWindowsSeq.st: -------------------------------------------------------------------------------- 1 | Class new title: ParcWindowsSeq subclassof: Sequencer fields: 'alto notetaker dorado' declare: ''; classified: 'Project Sequencing'  ParcWindowsSeq understands: 'resetSeq [ super resetSeq. user restore. ]'  ParcWindowsSeq understands: 'initSeq [ super initSeq. alto _ (FormWindow new) form: (user asset: ''XeroxAltoBW.form''). alto frame: (75450 extent: alto form extent). notetaker _ (FormWindow new) form: (user asset: ''Notetaker.form''). notetaker frame: (375500 extent: notetaker form extent). dorado _ (FormWindow new) form: (user asset: ''DoradoScreen.form''). dorado frame: (675450 extent: dorado form extent). ]'  ParcWindowsSeq understands: 'sequence [ count = 1  [alto show.]. count = 2  [notetaker show.]. count = 3  [dorado show.]. count > 3  [self resetSeq. "frame flash"]. ] '  -------------------------------------------------------------------------------- /updates/0155FaucetSeq.st: -------------------------------------------------------------------------------- 1 | Class new title: FaucetSeq subclassof: Sequencer fields: 'loc animate faucet drip1 drip2 drip3 ' declare: ''; classified: 'Project Sequencing'  FaucetSeq understands: 'sequence [ count = 1  [faucet displayat: loc + (180). animate _ true. until user bluebug do [drip1 displayat: loc + (0faucet extent y). user displayFlush. self delay. drip2 displayat: loc + (0faucet extent y). user displayFlush. self delay. drip3 displayat: loc + (0faucet extent y). user displayFlush. self delay. ]. ]. count = 2  []. count > 2  [self resetSeq. frame flash]. ]'  FaucetSeq understands: 'delay | jj [ for jj from: 1 to: 20000 do [jj]. ]'  FaucetSeq understands: 'resetSeq [ super resetSeq. user restore. ]'  FaucetSeq understands: 'initSeq [ super initSeq. loc _ 50400. faucet _ user asset: ''justFaucet.form''. drip1 _ user asset: ''drops1.form''. drip2 _ user asset: ''drops2.form''. drip3 _ user asset: ''drops3.form''. ]'  -------------------------------------------------------------------------------- /updates/0156FormWindowEditItem-di.st: -------------------------------------------------------------------------------- 1 | FormWindow understands: 'yellowbug | choices choice [choices _ (''dst _ src'' ''dst or src'' ''dst xor src'' ''dst and src'' ''dst _ ~src'' ''dst or ~src'' ''dst xor ~src'' ''dst and ~src'') copy. for choice to: 8 do [effect + 1 = choice  [choices  choice _ '' '' + (choices  choice) + '' '']]. choice _ (Menu new stringFromVector: (choices concat: (''edit''))) bug. choice = 0  [] choice = 9  [form edit] effect _ choice - 1. user restore]'  -------------------------------------------------------------------------------- /updates/0157batchArrow-yo.st: -------------------------------------------------------------------------------- 1 | ArrowWindow understands: 'draw: function | t [t _ Turtle init. [nil  function  [t function_ function]]. t width: (self style: borderWidth). t color: (self style: borderColor). t place: self beginPoint. t goto: self endPoint. t batch: true. self hasHead  [ t up. t turn: ((self endPoint - self beginPoint) theta / 3.1415926 * 180.0) + 90.0. t turn: 157. t go: 20. t penup. t turn: 180. t go: 20. t pendn. t turn: 23. t turn: 157 negated. t go: 20]]'  ArrowWindow understands: 'pointMove: whichPt | hotspot current other [hotspot _ self pointHotspot: stylewhichPt. until user anybug do [(hotspot has: user mp)  false  [false]]. self restore; draw: xoring. while user anybug do [ current _ user mp. [user shiftKey  [ [whichPt = beginPoint  [ other _ style  endPoint] other _ style  beginPoint]. [(other x - current x) abs > (other y - current y) abs  [ current _ current x  other y] current _ other x  current y]]]. self draw: xoring. style  whichPt _ current. self draw: xoring. ]. self draw: xoring. self frame: ((Rectangle new encompass: self beginPoint, self endPoint) inset: 2020). self show] '  -------------------------------------------------------------------------------- /updates/0158CodeWindowInit-di.st: -------------------------------------------------------------------------------- 1 | CodeWindow understands: 'class: cls selector: sel para: para formerly: formerly | pane [pane _ CodePane new class: cls selector: sel para: nil. self title: cls title + '' '' + sel with: pane inVector at: stdTemplates. self newframe. self show. pane showing: para. pane formerly: formerly. pane from: pane]'  CodeWindow understands: 'init: strOrPara [ self title: ''Text'' para: strOrPara]'  CodeWindow understands: 'title: str para: para | pane [pane _ CodePane new class: CodePane selector: ignore para: nil. self title: str with: pane inVector at: stdTemplates. self newframe. self show. pane showing: para. pane formerly: false. pane from: pane]'  -------------------------------------------------------------------------------- /updates/0159CodeWindowInFrame-di.st: -------------------------------------------------------------------------------- 1 | CodeWindow understands: 'title: str para: para | pane [ self title: str para: para inFrame: (Rectangle new fromuser)]'  CodeWindow understands: 'title: str para: para inFrame: rect | pane [pane _ CodePane new class: CodePane selector: ignore para: nil. self title: str with: pane inVector at: stdTemplates. self frame: rect. self show. pane showing: para. pane formerly: false. pane from: pane]'  -------------------------------------------------------------------------------- /updates/0161LibrarySeq.st: -------------------------------------------------------------------------------- 1 | Class new title: LibrarySeq subclassof: Sequencer fields: ' ' declare: ''; classified: 'Project Sequencing'  LibrarySeq understands: 'initSeq [ super initSeq. background _ user asset: ''Library-of-Congress.form''. user restore. ]'  LibrarySeq understands: 'sequence [ count = 1  []. count > 1  []. ]'  LibrarySeq understands: 'resetSeq [ super resetInit. ]'  -------------------------------------------------------------------------------- /updates/0163shapes2-yo.st: -------------------------------------------------------------------------------- 1 | ShapeWindow understands: 'pointMove: whichPt | hotspot current other [hotspot _ self pointHotspot: stylewhichPt. until user anybug do [(hotspot has: user mp)  false  [false]]. self restore; draw: xoring. while user anybug do [ current _ user mp. self draw: xoring. current _ self fixPoint: user mp of: whichPt. style  whichPt _ current. self draw: xoring. ]. self draw: xoring. self frame: self updateFrame. self show] '  -------------------------------------------------------------------------------- /updates/0165disableCache-yo.st: -------------------------------------------------------------------------------- 1 | UserView understands: 'restore: rect without: exclude| i w hideDisp last [kbMap _ NTkbMap. noupdate _ true. DisplayBLTer window: rect. rect clear. hideDisp _ self  self rootUserview. for i from: sched length to: 1 by: 1 do [(w _ schedi)  exclude  [] hideDisp and w  disp  [] [w showClipped: rect. last _ w]]. [last  nil  [last enter]]. DisplayBLTer window: screenrect. noupdate _ false]'  Window understands: 'grabBits ["bits _ frame bitsIntoString"]'  -------------------------------------------------------------------------------- /updates/0166simpleShapes-yo.st: -------------------------------------------------------------------------------- 1 | ArrowWindow understands: 'controlPoints [ (beginPoint endPoint)]'  ArrowWindow understands: 'draw: function | t [t _ Turtle init. [nil  function  [t function_ function]]. t width: (self style: borderWidth). t color: (self style: borderColor). t place: (self style: beginPoint). t goto: (self style: endPoint). t batch: true. (self style: hasHead) = true  [ t up. t turn: (((self style: endPoint) - (self style: beginPoint)) theta / 3.1415926 * 180.0) + 90.0. t turn: 157. t go: 20. t penup. t turn: 180. t go: 20. t pendn. t turn: 23. t turn: 157 negated. t go: 20]]'  ArrowWindow understands: 'updateFrame [ (Rectangle new encompass: (self style: beginPoint), (self style: endPoint)) inset: 2020] '  EllipseWindow understands: 'controlPoints [ (topPoint centerPoint rightPoint)]'  RectWindow understands: 'controlPoints [ (beginPoint endPoint)]'  ShapeWindow understands: 'controlPoints [ ()]'  ShapeWindow understands: 'eachtime | name [for name from: self controlPoints do [ (self pointHotspot: style  name) has: user mp  [self crossHairCursor showwhile [self pointMove: name]. true]]. super eachtime]'  StarWindow understands: 'controlPoints [ (centerPoint firstPoint)]'  ArrowWindow derstands: 'beginPoint' unique.  ArrowWindow derstands: 'eachtime' unique.  ArrowWindow derstands: 'endPoint' unique.  ArrowWindow derstands: 'hasHead' unique.  EllipseWindow derstands: 'eachtime' unique.  RectWindow derstands: 'eachtime' unique.  StarWindow derstands: 'eachtime' unique.  -------------------------------------------------------------------------------- /updates/0167RestoreFix-di.st: -------------------------------------------------------------------------------- 1 | CodePane understands: 'windowenter [self outline. parednil  [] pared enter]'  PanedWindow understands: 'show | p [super show. bits  nil  [] for p from: panes do [p windowenter; windowleave]]'  SymbolTable understands: 'allImplementersOf: selector | c cc ccc "Smalltalk allImplementersOf:  " [ ((user classNames transform c to [Smalltalkc]) all cc suchThat [(cc Is: Class) and (cc md has: selector)]) transform ccc to ccc title ]'  NotifyWindow understands: 'enter | t1 t2 t3 t4 t5 t6 [enoughpanes  [super enter] NotifyFlag _ false. t1 _ panes  1. t2 _ CodePane new. t3 _ VariablePane new. t4 _ CodePane new. t5 _ VariablePane new. t6 _ CodePane new. self title: title with: t1 , t2 , t3 , t4 , t5 , t6 at: bigTemplates. self frame: frame. t1 context: t3 instance: t5 code: t2. t2 from: t1. t3 to: t4. t4 from: t3. t5 to: t6. t6 from: t5. t1 select: 0. t1 deselected. t1 makeParagraph. t1 fill. self show. NotifyFlag _ true. enoughpanes _ NotifyFlag]'  SymbolTable derstands: 'allImplementorsOf:' unique.  SymbolTable derstands: 'implementorsOf:' unique.  -------------------------------------------------------------------------------- /updates/0168ImplementersMenu-di.st: -------------------------------------------------------------------------------- 1 | SelectorPane understands: 'classInit " SelectorPane classInit. " [editmenu _ Menu new string: ''senders implementers filout spawn forget'']'  SelectorPane understands: 'yellowbug | [selection = 0  [window flash] scrollBar hidewhile [editmenu bug = 1  [user cr; show: ''senders of '' + (listselection) + ''...''; cr; show: (Smalltalk allCallsOn: listselection from: user classNames); cr; show: ''-----''; cr]; = 2  [user cr; show: ''implementers of '' + (listselection) + ''...''; cr; print: (Smalltalk allImplementersOf: listselection); cr; show: ''-----''; cr]; = 3  [organizationPane filout: list  selection]; = 4  [organizationPane spawn: list  selection with: codePane contents formerly: codePane oldContents]; = 5  [organizationPane forget: list  selection]]]'  SelectorPane classInit  -------------------------------------------------------------------------------- /updates/0169RestoreTweak-di.st: -------------------------------------------------------------------------------- 1 | UserView understands: 'restore: rect without: exclude| i w hideDisp last [kbMap _ NTkbMap. noupdate _ true. DisplayBLTer window: rect. rect clear. hideDisp _ self  self rootUserview. for i from: sched length to: 1 by: 1 do [(w _ schedi)  exclude  [] hideDisp and w  disp  [] [w showClipped: rect. last _ w]]. DisplayBLTer window: screenrect. noupdate _ false]'  -------------------------------------------------------------------------------- /updates/0170RestoreTweak2-di.st: -------------------------------------------------------------------------------- 1 | UserView understands: 'restore: rect without: exclude| i w hideDisp last [rect _ screenrect. "***Temporarily disabled clipping while we get it right" kbMap _ NTkbMap. noupdate _ true. DisplayBLTer window: rect. rect clear. hideDisp _ self  self rootUserview. for i from: sched length to: 1 by: 1 do [(w _ schedi)  exclude  [] hideDisp and w  disp  [] [w showClipped: rect. last _ w]]. DisplayBLTer window: screenrect. noupdate _ false]'  -------------------------------------------------------------------------------- /updates/0171RestoreTweak3-di.st: -------------------------------------------------------------------------------- 1 | BitRectEditor understands: 'bluebug | [ "picture is: BitImage [  picture fromrectangle: (picture rectangle)]" windowmenu bug =1 elf leave. exitflag _ false]; "under" =2 elf leave; newframe; enter]; "move" =3 elf grow "grow"]; =4 elf leave. user unschedule: self. self restore. false]; =5 elf leave. picture filout. self enter]; "filout" =6 elf print]; =7 elf inspect]; =8 ool inspect]; =9 [(tool''pencil'') inspect] ]'  SelectorPane understands: 'yellowbug | [selection = 0  [window flash] scrollBar hidewhile [editmenu bug = 1  [user cr; cr; show: ''senders of '' + (listselection) + ''...''; cr; show: (Smalltalk allCallsOn: listselection from: user classNames); show: ''-----''; cr]; = 2  [user cr; cr; show: ''implementers of '' + (listselection) + ''...''; cr; print: (Smalltalk allImplementersOf: listselection); cr; show: ''-----''; cr]; = 3  [organizationPane filout: list  selection]; = 4  [organizationPane spawn: list  selection with: codePane contents formerly: codePane oldContents]; = 5  [organizationPane forget: list  selection]]]'  SymbolTable understands: 'allCallsOn: t1 from: t2 | t3 t4 t5 t6 t7 [[t1 is: Vector  [] t1 _ t1 inVector]. t4 _ Stream default. user displayoffwhile [for t3 from: t2 do [t6 _ self  t3. for t7 from: t1 do [t5 _ t6 whosends: t7. t5 length = 0  [] t4 append: t3. t4 append: ''''. t4 append: t5. t4 cr]]. nil]. t4 contents]'  -------------------------------------------------------------------------------- /updates/0172Learn-di.st: -------------------------------------------------------------------------------- 1 | Object understands: 'learn: methodString "It''s the wild wild west..." [ self class understands: methodString]'  -------------------------------------------------------------------------------- /updates/0173arrowMidPoint-yo.st: -------------------------------------------------------------------------------- 1 | ArrowWindow understands: 'controlPoints [ (beginPoint endPoint centerPoint)]'  ArrowWindow understands: 'default | pt [self crossHairCursor showwhile [pt _ user waitbug]. self style: beginPoint _ pt. self style: endPoint _ pt. self style: centerPoint _ pt. self style: hasHead _ true. frame _ (pt rect: pt) inset: 2020. self pointMove: endPoint]'  ArrowWindow understands: 'draw: function | t headAngle w [t _ Turtle init. [nil  function  [t function_ function]]. w _ self style: borderWidth. t width: w. t color: (self style: borderColor). t place: (self style: beginPoint). t goto: (self style: endPoint). t batch: true. headAngle _ 12. [w  8  [headAngle _ 23] w = 4  [headAngle _ 18] w = 2  [headAngle _ 14]]. (self style: hasHead) = true  [ t up. t turn: (((self style: endPoint) - (self style: beginPoint)) theta / 3.1415926 * 180.0) + 90.0. t turn: (180 - headAngle). t go: 20. t penup. t turn: 180. t go: 20. t pendn. t turn: headAngle. t turn: (180 - headAngle) negated. t go: 20]]'  ArrowWindow understands: 'fixPoint: pt of: whichPt | other [user shiftKey  [ [whichPt = beginPoint  [ other _ style  endPoint] other _ style  beginPoint]. [(other x - pt x) abs > (other y - pt y) abs  [  pt x  other y]  other x  pt y]] [whichPt = centerPoint  [ self style: beginPoint _ (self style: beginPoint) + pt - (self style: centerPoint). self style: endPoint _ (self style: endPoint) + pt - (self style: centerPoint)] whichPt = beginPoint  [ self style: centerPoint _ ((self style: endPoint) + pt) / 2] whichPt = endPoint  [ self style: centerPoint _ ((self style: beginPoint) + pt) / 2]].  pt]'  -------------------------------------------------------------------------------- /updates/0174windowInTextframe-yo.st: -------------------------------------------------------------------------------- 1 | Textframe understands: 'displayall | y save ["Kludge: globally clip to window. Should fix the drawing instead" save _ DisplayBLTer window. DisplayBLTer window: (window intersect: save). y _ self displaylines: 1 to: lastline. self clearfrom: y. DisplayBLTer window: save]'  -------------------------------------------------------------------------------- /updates/0176SetTitle-di.st: -------------------------------------------------------------------------------- 1 | Window understands: 'bluebug | str [windowmenu bug =1[exitflag _ false]; =2elf newframe; enter]; =3elf close. user unschedule: self. self restore. self leave. false]; =4elf style: noTitle _ (self style: noTitle)  false. user restore]; =5elf styleEdit]; =6elf forgetBits; leave; enter]; =7elf hardcopy]; =8elf duplicate]; =9tr _ user request: ''New Title? ''. titlepara _ str asParagraph allBold]; =10elf inspect]]'  Window understands: 'classInit "Window classInit. " [border _ 2  2. titleframe _ Textframe new para: ''ignore'' asParagraph frame: (5050 rect: 100100). titleloc _ 3  (4 - titleframe lineheight). titlerun _ String new: 2. titlerun word: 1 _ 255. (defaultStyle _ Dictionary new: 10) insert: fill with: white; insert: borderWidth with: 2; insert: borderColor with: black. windowmenu _ Menu new string: ''to bottom frame close toggle title border & fill restore print duplicate new title inspect '']'  Window classInit  -------------------------------------------------------------------------------- /updates/0177DuplicateCodeWindow-di.st: -------------------------------------------------------------------------------- 1 | CodePane understands: 'pared [ pared]'  CodeWindow understands: 'duplicate | copy "return a deep copy of this code window" [copy _ CodeWindow new title: self title + ''1'' para: self editor para copy inFrame: (self frame copy moveby: 3030). copy editor style: self editor style. user schedule: copy. self leave.  false] '  CodeWindow understands: 'editor [ (panes1) pared]'  Window understands: 'bluebug | str [windowmenu bug =1[exitflag _ false]; =2elf newframe; enter]; =3elf close. user unschedule: self. self restore. self leave. false]; =4elf style: noTitle _ (self style: noTitle)  false. user restore]; =5elf styleEdit]; =6elf forgetBits; leave; enter]; =7elf hardcopy]; =8[ self duplicate]; =9tr _ user request: ''New Title? ''. titlepara _ str asParagraph allBold]; =10elf inspect]]'  Window understands: 'classInit "Window classInit. " [border _ 2  2. titleframe _ Textframe new para: ''ignore'' asParagraph frame: (5050 rect: 100100). titleloc _ 3  (4 - titleframe lineheight). titlerun _ String new: 2. titlerun word: 1 _ 255. (defaultStyle _ Dictionary new: 10) insert: fill with: white; insert: borderWidth with: 2; insert: borderColor with: black. windowmenu _ Menu new string: ''to bottom frame close toggle title border & fill restore print duplicate new title inspect '']'  CodeWindow derstands: 'duplicateFrom:' unique.  Window classInit  -------------------------------------------------------------------------------- /updates/0180copyStyle-bf.st: -------------------------------------------------------------------------------- 1 | 'Copy style when duplicating window'  CodeWindow understands: 'duplicate | copy "return a deep copy of this code window" [copy _ CodeWindow new title: self title + ''1'' para: self editor para copy inFrame: (self frame copy moveby: 3030). copy style_ style copy. copy editor style: self editor style. user schedule: copy. self leave.  false]'  Window understands: 'style_ dict [style _ dict]'  -------------------------------------------------------------------------------- /updates/0181kbdResize-bf.st: -------------------------------------------------------------------------------- 1 | 'Resize by keyboard'  Window understands: 'resize | rect [rect _ self resizeHotspot. until user anybug do [ user kbck  [ "pressed key, reframe by keyboard" frame boxcomp. until user anybug do [ user kbdnext = 193  [self resizeBy: 10. frame boxcomp]; = 194  [self resizeBy: 10. frame boxcomp]; = 195  [self resizeBy: 01. frame boxcomp]; = 196  [self resizeBy: 01. frame boxcomp];  false  [frame boxcomp]]. frame boxcomp. user waitnobug]. (rect has: user mp)  false  [false]]. self aboutToFrame. rect _ frame copy. frame boxcomp. until user nobug do [ frame corner  user mp  [ frame boxcomp. frame growto: user mp. frame boxcomp]]. frame boxcomp. self frame: frame. self forgetBits. user restore]'  Window understands: 'resizeBy: pt | outer r [self frame: (frame growby: pt). user restore. " outer _ frame. [self style: noBorder  [] outer _ outer inset: 11 * (self style: borderWidth)]. for r from: (outer minus: outer + pt) do [ user restore: r without: self]. self frame: (frame moveby: pt). self show"]'  -------------------------------------------------------------------------------- /updates/0182DebugFrameFixAgain-di.st: -------------------------------------------------------------------------------- 1 | NotifyWindow understands: 'enter | t1 t2 t3 t4 t5 t6 [enoughpanes  [super enter] NotifyFlag _ false. t1 _ panes  1. t2 _ CodePane new. t3 _ VariablePane new. t4 _ CodePane new. t5 _ VariablePane new. t6 _ CodePane new. self title: title with: t1 , t2 , t3 , t4 , t5 , t6 at: bigTemplates. self frame: frame. t1 context: t3 instance: t5 code: t2. t2 from: t1. t3 to: t4. t4 from: t3. t5 to: t6. t6 from: t5. t1 select: 0. t1 deselected. t1 makeParagraph. t1 fill. self show. NotifyFlag _ true. enoughpanes _ NotifyFlag]'  -------------------------------------------------------------------------------- /updates/0183listenerTabs-bf.st: -------------------------------------------------------------------------------- 1 | 'Indent listener result, and no doit char'  TextImage understands: 'doit: forListener | result strm c2s s "Listener wants CR, prompt; cmd-D wants space and select result" ["if null selection, extend to prompt or current line" [c1 = c2  [self selectLine] self unselect]. c2s _ c2. "evaluate the selection" result _ Generator new evaluate: self selectionAsStream in: false to: nil notifying: self. self select: c2s. "add a space and print the result with cr" strm _ Stream default. forListener  [strm crtab: 3; print: result; cr; next_ 20. self paste: strm contents. self select: c2] "doit" strm space; print: result; cr. self paste: strm contents]'  -------------------------------------------------------------------------------- /updates/0184TurtleFix-di.st: -------------------------------------------------------------------------------- 1 | Form understands: 'captureDisplay | br [br _ BitRect new title: ''BitRect'' in: self frame. br saveScreenBits. br copyToForm: self at: 00. ]'  FormWindow understands: 'captureDisplay | br [br _ BitRect new title: ''BitRect'' in: self frame. br saveScreenBits. br copyToForm: form at: 00. ]'  FormWindow understands: 'leave [[turtlemodetrueelf captureDisplay]]. super leave]'  Turtle understands: 'turtleTests " Evaluate the top and bottom doits separately in order... | w extent. extent _ 300300. w _ FormWindow new. w form: (Form new extent: extent); title_ ''Turtle''; turtlemode: true; frame: (200200 rect: extent); show. user schedule: w. | pen i tw . tw _ user''Turtle''. tw enter. pen _ Turtle init: tw frame. pen color: black; width: 2; inking: oring. for i to: 100 do [pen go: i * 4; turn: 89]. tw leave. "'  -------------------------------------------------------------------------------- /updates/0185TurtleFix2-di.st: -------------------------------------------------------------------------------- 1 | FormWindow understands: 'captureDisplay | br [br _ BitRect new title: ''BitRect'' in: self frame. br saveScreenBits. br copyToForm: form at: 00. effect _ 0. ]'  FormWindow understands: 'turtlemode: trueforframeandcapture [turtlemode _ trueforframeandcapture. effect _ 0]'  -------------------------------------------------------------------------------- /updates/0186D1doit-yo.st: -------------------------------------------------------------------------------- 1 | D1TextPane understands: 'handleGesture: r stroke: ps | rect left right isMargin [left _ pared frame origin x. right _ pared frame corner x. isMargin _ false. [(r  1) = ''U''  [ rect _ D1Stroke new encompassingRectangle: ps. isMargin _ true. left _ rect origin x. right _ rect corner x] (r  1) = ''L''  [ isMargin _ true. left _ (ps  1) x] (r  1) = ''R''  [ isMargin _ true. right _ (ps  1) x]]. [isMargin  [pared frame _ (left  origFrame origin y) rect: (right  origFrame corner y)]]. [(r  1) = ''scrub'' [pared replace: ''''] (r  1) = ''circle'' [pared undo] (r  1) = ''check'' [self doit]]. [nil  result  [result text: r asString]]]'  -------------------------------------------------------------------------------- /updates/0187TurtleFix3-di.st: -------------------------------------------------------------------------------- 1 | FormWindow understands: 'frame: f [[turtlemodetrueorm _ Form new extent: f extent]]. super frame: f]'  -------------------------------------------------------------------------------- /updates/0190editTitle-bf.st: -------------------------------------------------------------------------------- 1 | 'Allow editing title of workspace and shape windows'  EllipseWindow understands: 'default | rect [self init. rect _ Rectangle fromuser. self style: topPoint _ rect center x  rect top. self style: rightPoint _ rect rightside  rect center y. self frame: self updateFrame]'  PanedWindow understands: 'editTitle [super editTitle. title _ titlepara text]'  ShapeWindow understands: 'default | pt pos [self init. self crossHairCursor showwhile [pos _ user waitbug]. for pt from: self controlPoints do [ self style: pt _ pos]. frame _ self updateFrame. self pointMove: self controlPoints last]'  ShapeWindow understands: 'init | pt pos [self style: fill _ nil; style: borderWidth _ 4; style: noTitle _ true]'  ShapeWindow understands: 'outside [[self style: noTitle  [] titleframe window has: user mp  [user anybug  [self editTitle] false]]. false]'  ShapeWindow understands: 'show [growing  [] self draw: storing. self showtitle]'  ShapeWindow understands: 'showtitle [self style: noTitle  []. super showtitle. frame border: 2 color: black]'  Window understands: 'editTitle | text rect key [rect _ self fullTitleFrame growto: user screenrect maxX(frame minY-4). text _ TextImage new para: titlepara frame: rect + (32). text formerly: false. text enter. until (key = 13 or (user anybug and (rect has: user mp)  false)) do [(key _ user kbck)  [ key = 13  [user kbd] text typing]. user redbug  [rect has: user mp  [text selecting]] user yellowbug  [rect has: user mp  [rect flash]]]. titlepara _ text contents. titlepara allBold. self showtitle. user restore]'  CodeWindow derstands: 'editTitle' unique.  | s . for s from: user allWindowsInAllProjects do [ s Is: ShapeWindow  [s style: noTitle _ true]].  -------------------------------------------------------------------------------- /updates/0191scrollBar-bf.st: -------------------------------------------------------------------------------- 1 | 'Prevent error from hidden scrollbar'  ScrollBar understands: 'hidewhile block | result [[self showing  [ self hide. result _ block eval. self show] result _ block eval]. result]'  -------------------------------------------------------------------------------- /updates/0192listenerEar.st: -------------------------------------------------------------------------------- 1 | 'Patch font with ear for listener prompt, use one tab in result'  DefaultTextStyle fontset0 charForm: 20 _ (Form new fromInstance: (user fileString: updateURL + 'ear.form') asStream).  TextImage understands: 'doit: forListener | result strm c2s s "Listener wants CR, prompt; cmd-D wants space and select result" ["if null selection, extend to prompt or current line" [c1 = c2  [self selectLine] self unselect]. c2s _ c2. "evaluate the selection" result _ Generator new evaluate: self selectionAsStream in: false to: nil notifying: self. self select: c2s. "add a space and print the result with cr" strm _ Stream default. forListener  [strm crtab: 1; print: result; cr; next_ 20. self paste: strm contents. self select: c2] "doit" strm space; print: result; cr. self paste: strm contents]'  TextImage understands: 'selectLine [ "Extend the current selection back to CR or prompt, and forward to the end of the line or text" until (c1 = 1 or ((para(c1-1)=13) or: (para(c1-1)=20))) do [c1 _ c1 - 1]. c2 _ para length+1 min: c1. until (c2 = (para length+1) or parac2=13) do [c2 _ c2 + 1]]'  -------------------------------------------------------------------------------- /updates/0194Convenience-di.st: -------------------------------------------------------------------------------- 1 | SymbolTable understands: 'allGlobals | s " Smalltalk allGlobals " "return an array of names of non-classes in me" [ self contents all s suchThat [(selfs Is: Class)false]]'  Window understands: 'printon: strm [super printon: strm. strm append: ''(''; print: self title. [self inactivetrm append: '', inactive'']]. [self style: tickingtrm append: '', ticking'']]. strm append: '')'']'  -------------------------------------------------------------------------------- /updates/0195ActivateTweak-di.st: -------------------------------------------------------------------------------- 1 | Window understands: 'activate [(self style: inactive)  false  [] self style: inactive _ false. user promote: self]'  -------------------------------------------------------------------------------- /updates/0196ActivateTweak2-di.st: -------------------------------------------------------------------------------- 1 | Window understands: 'activate [(self style: inactive)  false  [] self style: inactive _ false. user promote: self. self show]'  -------------------------------------------------------------------------------- /updates/0197hideInactive-bf.st: -------------------------------------------------------------------------------- 1 | 'Do not show inactive windows'  UserView understands: 'restore: rect without: exclude| i w hideDisp last [rect _ screenrect. "***Temporarily disabled clipping while we get it right" kbMap _ NTkbMap. noupdate _ true. DisplayBLTer window: rect. rect clear. hideDisp _ self  self rootUserview. for i from: sched length to: 1 by: 1 do [(w _ schedi)  exclude  [] hideDisp and w  disp  [] w inactive  [] w showClipped: rect. last _ w]. DisplayBLTer window: screenrect. noupdate _ false]'  -------------------------------------------------------------------------------- /updates/0198formWindowTitle-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix window title not showing. Also, allow dragging by redbug. And fix effect not being initialized.'  FormWindow understands: 'captureDisplay [self form: (DisplayForm copy: frame)]'  FormWindow understands: 'form [form]'  FormWindow understands: 'form: aForm [form _ aForm. self reset. effect  nil  [effect _ storing]]'  FormWindow understands: 'frame: f [[turtlemodetrue and f extent  form extent [self form: (Form new extent: f extent)]]. super frame: f]'  FormWindow understands: 'initForm: aForm [self form: aForm. self newframe. self show]'  FormWindow understands: 'redbug | oldFrame offset [oldFrame _ self fullFrame. offset _ user mp - frame origin. frame boxcomp. while user anybug do [ frame boxcomp. frame moveto: user mp - offset. frame boxcomp]. frame boxcomp. oldFrame = self fullFrame  [] user restore: oldFrame without: self. self show]'  FormWindow understands: 'show [super show. bits  nil  [] "already shown" form displayat: frame origin effect: effect]'  FormWindow understands: 'turtlemode: trueforframeandcapture [turtlemode _ trueforframeandcapture. effect _ storing]'  FormWindow understands: 'yellowbug | choices choice [choices _ (''dst _ src'' ''dst or src'' ''dst xor src'' ''dst and src'' ''dst _ ~src'' ''dst or ~src'' ''dst xor ~src'' ''dst and ~src'') copy. for choice to: 8 do [effect + 1 = choice  [choices  choice _ '' '' + (choices  choice) + '' '']]. choice _ (Menu new stringFromVector: (choices concat: (''edit''))) bug. choice = 0  [] choice = 9  [form edit] effect _ choice - 1. user restore: frame]'  Window understands: 'fullFrame | rect [rect _ frame copy. [self style: noBorder  [] rect _ rect inset: 11 * (self style: borderWidth)]. rect _ rect include: self fullTitleFrame. rect] '  Window understands: 'title_ aTitle [titlepara _ aTitle asParagraph allBold]'  -------------------------------------------------------------------------------- /updates/0200misc-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix glyphsForm. Speed up dragging of menu larger than screen. Kerned fonts display with oring (unfinished).'  Font understands: 'glyphsForm "Note: must share the glyphs bits for edit to work." [ Form new extent: (self byteraster*8)(glyphs length/self byteraster) bits: glyphs]'  Menu understands: 'fbug | result bits orgFrame offs form [bits _ self movingsetup. orgFrame _ frame copy. [frame height  user screenrect height  [user waitbug] until user redbug do [ user yellowbug and (frame has: user mp)  [ form _ DisplayForm copy: (frame minX0 rect: frame maxXuser screenrect maxY). offs _ user mp y. until user nobug do [form displayat: frame minX(user mp y - offs)]. self moveto: frame minX  (frame minY + user mp y - offs); show]]]. result _ self bugit. orgFrame bitsFromString: bits. result]'  TextScanner understands: 'scanword: lasti | ascii w [function _ [kern = 0  [16] 17]. until chari > lasti do [ascii _ text  chari. exceptions  (ascii + 1)  0  [exceptions  (ascii + 1)] ascii < minascii or ascii > maxascii  [11] sourcex _ xtable  (ascii + 1). width _ xtable  (ascii + 2) - sourcex. [printing  [self callBLT]]. [kern > 0  [w _ width + charpad - kern. w < 2  [w _ 2]] w _ width + charpad]. destx _ destx + w. destx > stopx  [2] chari _ chari + 1]. chari _ chari - 1. 10] primitive: 50'  -------------------------------------------------------------------------------- /updates/0203deselectAfterDoit-bf.st: -------------------------------------------------------------------------------- 1 | 'Deselect after doit key if deselectAfterDoit is true'  Smalltalk declare: deselectAfterDoit as: false.  TextImage understands: 'doit: forListener | result strm c2s s "Listener wants CR, prompt; cmd-D wants space and select result" ["if null selection, extend to prompt or current line" [c1 = c2  [self selectLine] self unselect]. c2s _ c2. "evaluate the selection" result _ Generator new evaluate: self selectionAsStream in: false to: nil notifying: self. self select: c2s. "add a space and print the result with cr" strm _ Stream default. forListener  [strm crtab: 1; print: result; cr; next_ 20; space. self paste: strm contents. self select: c2] "doit" strm space; print: result. self paste: strm contents. deselectAfterDoit  [self select: c2]]'  -------------------------------------------------------------------------------- /updates/0205pickItem-bf.st: -------------------------------------------------------------------------------- 1 | 'Allow choosing an item from a vector by menu. E.g. user unschedule: user sched choose; restore. '  Array understands: 'choose | index [index _ (Menu new stringFromVector: self) fbug. index > 0  [self  index]. false]'.  Menu understands: 'stringFromVector: vec | item stream [stream _ Stream default. for item from: vec do [stream append: item asString; cr]. self string: stream contents]'  -------------------------------------------------------------------------------- /updates/0208formModes-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix rendering with no fill. Also, turn off fill when choosing special effect.'  FormWindow understands: 'show [super show. form displayat: frame origin effect: effect]'  FormWindow understands: 'yellowbug | choices choice [choices _ (''dst _ src'' ''dst or src'' ''dst xor src'' ''dst and src'' ''dst _ ~src'' ''dst or ~src'' ''dst xor ~src'' ''dst and ~src'') copy. for choice to: 8 do [effect + 1 = choice  [choices  choice _ '' '' + (choices  choice) + '' '']]. choice _ (Menu new stringFromVector: (choices concat: (''edit''))) bug. choice = 0  [] choice = 9  [form edit] effect _ choice - 1. (effect land: 3)  0  "needs background" [[(self style: fill) = 0  [self style: fill _ nil]]. user restore: frame] self show]'  Rectangle understands: 'color: color mode: mode [color  nil  [] color is: Form  [self tile: color mode: mode] DisplayBLTer bltrect: self topt: origin mode: 12 + (mode land: 3) color: color]'  -------------------------------------------------------------------------------- /updates/0209recogCreateWindow-yo.st: -------------------------------------------------------------------------------- 1 | D1TextPane understands: 'alignment: anInteger [pared alignment _ anInteger]'  D1TopWindow understands: 'alignment: anInteger [(panes  1) alignment: anInteger]'  D1TopWindow understands: 'setBounds: rect | recog result debug div [debug _ false. recog _ D1TextPane new. result _ D1ResultPane new. div _ 0. [debug  [div _ 3]]. self title: ''Tablet'' with: recog, result at: (0  div rect: 3636), (00 rect: 36  div). self frame: rect. result showing: ''''. recog showing: ''abc''. "self show." [debug  [recog to: result]]]'  UserView understands: 'recognizeStroke: stroke | result ps cls d [ps _ stroke points. stroke preProcess. result _ self recognizer recognizeStroke: stroke. [(result  1) = ''star''  [cls _ StarWindow]; = ''circle''  [cls _ EllipseWindow]; = ''arrow''  [cls _ ArrowWindow]]. [nil  cls  [ user schedule: (cls new setBounds: (Rectangle new encompass: ps))] (result  1) = ''rectangle''  [ d _ D1TopWindow new setBounds: (Rectangle new encompass: ps). d style: noTitle _ true. d text: ''''. d alignment: 2. user schedule: d]]]'  -------------------------------------------------------------------------------- /updates/0210recogShapeDelete-yo.st: -------------------------------------------------------------------------------- 1 | ShapeWindow understands: 'eachtime | name [for name from: self controlPoints do [ (self pointHotspot: style  name) has: user mp  [self crossHairCursor showwhile [self pointMove: name]. true]]. [user shiftKeyelf recognize.  true]]. super eachtime]'  ShapeWindow understands: 'recognize | stroke result [RecogCursor showwhile [ while user shiftKey do [ user redbug  [ stroke _ D1Stroke fromuser. stroke  [self recognizeStroke: stroke]]]]]'  ShapeWindow understands: 'recognizer [ D1Recognizer new default]'  ShapeWindow understands: 'recognizeStroke: stroke | result ps cls d [ps _ stroke points. stroke preProcess. result _ self recognizer recognizeStroke: stroke. [(result  1) = ''delete''  [ self close. user unschedule: self. self restore. self leave. false]]] '  -------------------------------------------------------------------------------- /updates/0211userWait-bf.st: -------------------------------------------------------------------------------- 1 | 'Provide wait: and waitUntil: in user which flush the display and makes the VM wait for a couple of milliseconds'  UserView understands: 'primWait: milliseconds ["okay to fail"] primitive: 104'  UserView understands: 'wait: milliseconds [self waitUntil: self ticks + milliseconds]'  UserView understands: 'waitUntil: ticks | remaining [self displayFlush. until (remaining _ ticks - self ticks)  0 do [self primWait: remaining]]'  -------------------------------------------------------------------------------- /updates/0213Helpers-di.st: -------------------------------------------------------------------------------- 1 | Class understands: 'title: nm insystem: system | cl name [name _ nm unique. superclass _ Object. [system has: name [cl _ (systemname) class. clself class [self] user notify: name + '' will change from a '' + cl title + '' to a '' + self class title + '' if you proceed...'']]. system declare: name as: self. AllClassNames _ AllClassNames insertSorted: name. SystemOrganization classify: name under: ''As yet unclassified'']'  UserView understands: 'anybug [self idle. self buttons > 0]'  UserView understands: 'bluebug [self idle. self buttons = 1]'  UserView understands: 'mpnext [self redbug  [self idle. self mp] false]'  UserView understands: 'redbug [self idle. self buttons = 4]'  UserView understands: 'yellowbug [self idle. self buttons = 2]'  Window understands: 'startTicking [self style: ticking _ true]'  Window understands: 'stopTicking [self style: ticking _ false]'  -------------------------------------------------------------------------------- /updates/0217reflowForm-bf.st: -------------------------------------------------------------------------------- 1 | 'Reflow form pixels by shift-click and drag'  Form understands: 'displayReflown: rect [self displayReflown: rect in: DisplayForm]'  Form understands: 'displayReflown: rect in: destForm| b [b _ BitBlt new. b function _ storing. b sourceForm _ self. b source _ 00. b destForm _ destForm. b dest _ rect origin. b height _ 1. while true do [ b width _ rect maxX - b destx min: extent x - b sourcex. b callBLT. b sourcex _ b sourcex + b width. b destx _ b destx + b width. [b sourcex  extent x  [b sourcex _ 0. b sourcey _ b sourcey + 1. b sourcey  extent y  [self]]]. [b destx  rect maxX  [b destx _ rect minX. b desty _ b desty + 1. b desty  rect maxY  [self]]]]] '  FormWindow understands: 'redbug | oldFrame offset [user shiftKey  [self reflow] oldFrame _ self fullFrame. offset _ user mp - frame origin. frame boxcomp. while user anybug do [ frame boxcomp. frame moveto: user mp - offset. frame boxcomp]. frame boxcomp. oldFrame = self fullFrame  [] user restore: oldFrame without: self. self show]'  FormWindow understands: 'reflow | bgbits saved offset w h [self restore. bgbits _ user screenrect bitsIntoString. self outline. saved _ frame copy. offset _ frame width - user x. until user nobug do [ w _ user x + offset max: 4. h _ saved width * saved height / w. frame extent _ wh. user screenrect bitsFromString: bgbits. self outline. form displayReflown: frame]. frame _ saved. user screenrect bitsFromString: bgbits. self show]'  -------------------------------------------------------------------------------- /updates/0219requestRestart-bf.st: -------------------------------------------------------------------------------- 1 | 'Send requestRestart to user to gently restart mainloop asap'  Class new title: UserView subclassof: Object fields: 'screenrect " current screen size" vtab " offset from hardware top" htab " offset from hardware left" scale " 2 means double bits mode" color " background halftone" projectWindow "my representative in an overview" disp " default message stream" sched " Windows in this view" noupdate " do not update display"' declare: 'mxoffset myoffset screenMenu tickIndex restartRequested currentCursor '; classified: 'Kernel Classes'  UserView understands: 'requestRestart "gently restart main loop" [restartRequested _ true]'  UserView understands: 'run: topFlag | i w forward "topFlag means sched1 already is awake" [forward _ [topFlag [w_sched1. while w eachtime do []. w lasttime] true]. restartRequested _ false. until restartRequested do [i_0. [forward or sched length = 0  [beTopWindow _ nil] self toBottom: w. beTopWindow _ sched1]. until [(i_i+1) > sched length[] w _ schedi. w inactive  [false] w firsttime] do [self runTicks] i>sched length "check for bug in empty space" [user yellowbugelf bugScreenMenu]. user shiftKeyelf recognize]] sched promote: w. while w eachtime do [self runTicks] forward_ w lasttime]]'  -------------------------------------------------------------------------------- /updates/0221reframeFirst-bf.st: -------------------------------------------------------------------------------- 1 | 'Reframe window when activated near origin or corner'  Window understands: 'firsttime [(frame has: user mp) or self  beTopWindow  [self reset. self enter. self repositionOrResize  [] user waitnobug] false]'  Window understands: 'outside [[self style: noTitle  [] titleframe window has: user mp  [user anybug  [self editTitle] true]]. self repositionOrResize  [true] false]'  Window understands: 'repositionHotspot [frame origin - (1616) rect: frame origin + (88)]'  Window understands: 'repositionOrResize [self repositionHotspot has: user mp + OriginCursor offset  [OriginCursor showwhile self reposition. true] self resizeHotspot has: user mp + CornerCursor offset  [CornerCursor showwhile self resize. true] false]'  Window understands: 'resizeHotspot [frame corner - (88) extent: 3232]'  -------------------------------------------------------------------------------- /updates/0223BREtweaks2-di.st: -------------------------------------------------------------------------------- 1 | BitRectEditor understands: 'enter | start pt b [[self style: mondoFrameelf mondoEnter]]. self show. "self lostMouse[false]." dirty_false. for b from: actionbuttons do [b reset]. "show action menu above the picture" start_frame origin-1. pt _ start-(toolpic extent xactionpic extent y). actionpic moveto: pt. saveActionPic_actionpic bitsIntoString. self lostMouse[false] "last point I can return before having to restore bits under menus" actionpic show. pt _ actionbuttons1 moveto: pt. "action" pt _ actionbuttons3 moveto: pt. "mode" pt _ actionbuttons4 moveto: pt. "width" "show the next bank of action buttons" pt _ start-(toolpic extent x(actionpic extent y+1/2)). pt _ actionbuttons2 moveto: pt. "tone" pt _ actionbuttons5 moveto: pt. "grid" tool brushpt: (pt _ pt+(44)). tool editor_ self. (tool brush) moveto: pt; show. "show the tool pic" pt _ start-(toolpic extent x0). toolpic moveto: pt. saveToolPic _ toolpic bitsIntoString. toolpic show. tools moveto: pt; setvalue: tool. tool frame: frame; showon: actionbuttons.]'  BitRectEditor understands: 'reposition | rect "Hide tools when reposition" [rect _ self repositionHotspot. while (rect has: user mp) do [user kbck or: user anybug ["Hide tools when reposition" self leave. super reposition. self enter]]  false]'  BitRectEditor understands: 'repositionHotspot "Smaller hotSpot due to interference with tool menu" [frame origin - (88) rect: frame origin + (88)]'  -------------------------------------------------------------------------------- /updates/0225newProject-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix creating new projects'  UserView understands: 'bugScreenMenu | m w turtle i f index file [m _ 0. screenMenu bug = (m_m+1)  [projectWindow runParent]; = (m_m+1)  [projectSequencer visitNext]; = (m_m+1)  [self restore]; = (m_m+1)  [self schedule: ProjectWindow init]; = (m_m+1)  [self schedule: ProjectSorter init]; = (m_m+1)  [self schedule: BrowseWindow default]; = (m_m+1)  [self schedule: (CodeWindow new class: UserView selector: workspace para: (UserView code: workspace) formerly: false)]; = (m_m+1)  [w _ self loadFormWindow  [self schedule: w enter]]; = (m_m+1)  [user schedule: ArrowWindow default]; = (m_m+1)  [user schedule: RectWindow default]; = (m_m+1)  [user schedule: EllipseWindow default]; = (m_m+1)  [user schedule: StarWindow default]; = (m_m+1)  [self schedule: D1TopWindow default]; = (m_m+1)  [turtle _ Turtle init. turtle color: black; width: 4; inking: oring. for i to: 50 do [turtle go: i * 4; turn: 89]]; = (m_m+1)  [f _ self fileMenu: ''edit'' directory: '''' matching: ''*''  [self editFile: f]]; = (m_m+1)  [f _ self fileMenu: ''file in'' directory: '''' matching: ''*.st''  [self filin: f]]; = (m_m+1)  [f _ self fileMenu: ''file delete'' directory: '''' matching: ''*''  [self confirm: ''Really delete '' + f  [self fileString: f _ nil]]]; = (m_m+1)  [f _ self fileMenu: ''publish'' directory: '''' matching: ''*.st''  [file _ self fileString: f. self fileString: (self update: f _ file) _ file. self fileString: f _ nil]]; = (m_m+1)  [self loadUpdates]; = (m_m+1)  [user save]]'  -------------------------------------------------------------------------------- /updates/0226listKbd-bf.st: -------------------------------------------------------------------------------- 1 | 'Allow list navigation by cursor keys'  Class new title: ListPane subclassof: Textframe fields: 'list firstShown lastShown selection scrollBar' declare: 'pagedown end left right up home down pageup '  CodePane understands: 'doit | listen sel result printer [scrollBar hidewhile [listen _ pared isListening. sel _ pared selectRange. pared unselect; fintype. [sel empty  [pared selectLine. sel _ pared selectRange]]. result _ selectorPane execute: pared selectionAsStream for: self. sel  pared selectRange  ["syntax error"] sel _ sel stop + 1. pared selectRange: (sel to: sel). printer _ (String new: 100) asStream. [listen  [pared selectToPrompt. printer crtab: 1; print: result; cr; next_ 20; space] result  nil  [self] printer space; print: result]. pared paste: printer contents. listen or deselectAfterDoit  [pared select: pared selectRange stop + 1]]]'  ListPane understands: 'classInit [left _ 193. right _ 194. up _ 195. down _ 196. pageup _ 197. pagedown _ 198. home _ 202. end _ 203] '  ListPane understands: 'kbd [user kbd = up  [self moveSelectionBy:1]; = down  [self moveSelectionBy: 1]; = pageup  [self moveSelectionBy: window height / style lineheight - 1 * 1]; = pagedown  [self moveSelectionBy: window height / style lineheight - 1]; = home  [self moveSelectionBy:100]; = end  [self moveSelectionBy: 100] window flash]'  ListPane understands: 'moveSelectionBy: n | r w [scrollBar reposition [ selection = 0  [self scrollUp: n * style lineheight] self compselection. [n abs > 1  [self scrollUp: n * style lineheight]]. self select: ((selection + n max: 1) min: list length). r _ self selectionRect. w _ window inset: 0  (window height / 3). r bottom < w top  [self scrollUp: r bottom - w top] r top > w bottom  [self scrollUp: r top - w bottom]]]'  ListPane classInit  -------------------------------------------------------------------------------- /updates/0228mouseOffset-bf.st: -------------------------------------------------------------------------------- 1 | 'Leave mouse offset handling to the VM'  UserView understands: 'currentCursor: cursor [currentCursor _ cursor. "Offset handled by JS VM because it cannot move the pointer mxoffset _ cursor offset x - htab. myoffset _ cursor offset y - vtab." self mapDisplay]'  UserView understands: 'cursorloc_ pt "no-op on JS VM" [self primCursorLoc_ pt - (mxoffset  myoffset)]'  UserView understands: 'mapDisplay [DisplayBLTer _ BitBlt init. DisplayBLTer sourceForm _ DisplayForm. DisplayBLTer destForm _ DisplayForm. BitBlt init sourceForm _ currentCursor asForm; destForm _ DisplayForm; source _ 00; extent _ currentCursor extent; dest _ currentCursor offset; "indicate to VM that it should handle offset" function _ oring; installForIOP]'  -------------------------------------------------------------------------------- /updates/0231kbdSubst2-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix, and more keyboard substitutions: >> ~~ !! $$ %% &&'  TextImage understands: 'kbdSubstitute: key in: typed | prev subst first second replacement [c1  c2 or (c1 = begintypein and typed empty)  [false] prev _ [typed empty  [para(c1-1)] typed last]. subst _ ''=>>>==~=!=--..::>=<=#@<)^~~__$$!!'+30 inString+'%%&&'' asStream. until subst end do [ first _ subst next. second _ subst next. replacement _ subst next. first = prev and second = key  [if typed empty then [ c1 _ c1 - 1. self replace: replacement inString. c1 _ c2] else [typed skip:1; next _ replacement]. true]] false]'  -------------------------------------------------------------------------------- /updates/0232kbdSubst3-bf.st: -------------------------------------------------------------------------------- 1 | 'Another fix for typing over selection'  TextImage understands: 'kbdSubstitute: key in: typed | prev subst first second replacement [typed empty and (c1  1 or (c1  c2 or c1 = begintypein))  [false] prev _ [typed empty  [para(c1-1)] typed last]. subst _ ''=>>>==~=!=--..::>=<=#@<)^~~__$$!!'+30 inString+'%%&&'' asStream. until subst end do [ first _ subst next. second _ subst next. replacement _ subst next. first = prev and second = key  [if typed empty then [ c1 _ c1 - 1. self replace: replacement inString. c1 _ c2] else [typed skip:1; next _ replacement]. true]] false]'  TextImage understands: 'replace: typed [[oldEntity  [] oldEntity _ para. para _ para copy]. [begintypein  [begintypein _ begintypein min: c1] Deletion _ self selection]. self replace: c1 to: c2 - 1 with: typed. c2 _ c1 + typed length]'  -------------------------------------------------------------------------------- /updates/0233changeLogFix-bf.st: -------------------------------------------------------------------------------- 1 | 'The .changes were reset after 20K rather than shortened'  Class understands: 'install: sel method: m literals: l code: c backpointers: b | spec log [messagedict _ messagedict insert: sel method: m literals: l code: c backpointers: b. lastClass _ self. lastSelector _ sel. lastParagraph _ c. Changes insert: (spec _ title + '' '' + sel). if (Changes has: (spec _ ''~'' + spec)) then [Changes delete: spec]. user changeLog log do [self printMethod: sel on: log]]'  UserView understands: 'changeLog logVar do writer | log old n [FilinSource  nil  ["do not log filins"] log _ Stream default. logVar value_ log. writer value. log next_ 30; cr. old _ user fileString: ''.changes''. [old  nil  [old _ '''']]. old _ old asStream. [old limit  20000  [] old position_ old limit - 20000; skipTo: 30; skipTo: 13]. user fileString: ''.changes'' _ old rest + log contents]'  -------------------------------------------------------------------------------- /updates/0236filoutEscape-bf.st: -------------------------------------------------------------------------------- 1 | 'Escape literal doit characters when filing out a method'  Class understands: 'printMethod: sel on: stream | cat code codeStream [cat _ self organization invert: sel. code _ self code: sel. [code is: Paragraph  [code _ code text]]. stream append: self title + '' understands: ''. if (code has: 30) then [ "escape chunk separator" codeStream _ code asStream. until [stream print: (codeStream upto: 30). codeStream end] do [stream append: '' + 30 inString + '']] else [stream print: code]. [cat = false or cat = ''As yet unclassified''  [] stream append: '' classified: ''; print: cat]. stream cr]'  -------------------------------------------------------------------------------- /updates/0238AutoSelectAllMsgs-di.st: -------------------------------------------------------------------------------- 1 | ClassPane understands: 'selected [organizationPane class: Smalltalk  (list  selection). organizationPane select: 3]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0239menuFix-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix menu selecting wrong entry when clicking too quickly. Show UpCursor to indicate menu can be scrolled with yellow button'  Menu understands: 'bugit: buttonUpOK | pt [ [buttonUpOKser waitbug] user nobug  [0]]. thisline comp. while true do [pt _ user mp. text frame has: pt  [ [thisline has: pt  [] pt _ text ptofpt: pt. thisline comp; moveto: text frame origin x  pt y; comp]. user nobug  [1 + (thisline origin y - text frame origin y / text lineheight)]] thisline comp. until (text frame has: user mp) do [user nobug  [0]. user idle]. thisline comp]]'  Menu understands: 'fbug | result bits orgFrame offs form [bits _ self movingsetup. orgFrame _ frame copy. [frame height  user screenrect height  [user waitbug] UpCursor showwhile [ until user redbug do [ user yellowbug and (frame has: user mp)  [ form _ DisplayForm copy: (frame minX0 rect: frame maxXuser screenrect maxY). offs _ user mp y. until user nobug do [form displayat: frame minX(user mp y - offs)]. self moveto: frame minX  (frame minY + user mp y - offs); show]]]]. result _ self bugit. orgFrame bitsFromString: bits. result]'  -------------------------------------------------------------------------------- /updates/0241projectIcon-bf.st: -------------------------------------------------------------------------------- 1 | ProjectWindow understands: 'show | scale i win rect [self style: fill _ userview color. super show. scale _ frame extent * 1024 / userview screenrect extent. for i from: userview sched length to: 1 by: 1 do [ (win _ userview schedi) Is: Window  [ rect _ win frame * scale / 1024 + frame origin. (rect intersect: frame) outline: 1]]]'  UserView understands: 'color [color]'  -------------------------------------------------------------------------------- /updates/0243Org-fileOut-tk.st: -------------------------------------------------------------------------------- 1 | Class understands: 'filoutOrg | strm [strm _ Stream default. self filoutOrgOn: strm. user fileString: (self title + ''.org.st'') _ strm contents]' classified: 'organization'. Class understands: 'filoutOrgOn: strm | [strm append: self title + '' organization fromParagraph:''. strm cr; print: self organization asParagraph text; append: '' asParagraph.''; cr; cr]' classified: 'organization'. -------------------------------------------------------------------------------- /updates/0247projectIcon4-bf.st: -------------------------------------------------------------------------------- 1 | 'Snap thumbnail window outlines to byte boundaries'  Point understands: '| grid [Point new x: x | grid asPtX y: y | grid asPtY]' classified: 'logical operations'  ProjectWindow understands: 'makeIcon | factor icon outlines blt i win r [nil  frame  [] "top-level project window has no frame" factor _ userview screenrect extent / frame extent. factor _ factor x min: factor y. icon _ DisplayForm scaledDown: factor. if true then [ "set to true for window outlines" outlines _ Form new. outlines extent: icon extent; white. blt _ BitBlt new. blt destForm _ outlines. for i from: userview sched length to: 1 by: 1 do [ (win _ userview schedi) Is: Window  [ (win Is: ShapeWindow) or ((win style: noBorder) or win inactive)  [] "need to snap outline to 8*factor grid" r _ win frame + ((8*factor) - 10) | (8*factor1) / factor. blt bltrect: r topt: r origin mode: 12 color: black. r _ r inset: 1. blt bltrect: r topt: r origin mode: 12 color: white]]. outlines displayat: 00 effect: oring in: icon]. self style: fill _ icon]' classified: 'drawing'  -------------------------------------------------------------------------------- /updates/0249messageNotUnderstood-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix message not understood handling'  Object understands: 'error | ctx sender op args "after compiling execute: nil installError. " [ctx _ thisContext current. sender _ ctx sender. op _ sender thisop. args _ ctx arguments: op numArgs. self messageNotUnderstood: op withArgs: args from: sender]' classified: 'as yet unclassified'  Object understands: 'messageNotUnderstood: op withArgs: args from: sender ["thisContext sender _ sender." user notify: ''Message not understood: '' + op]' classified: 'as yet unclassified'  ProcessFrame understands: 'arguments [self arguments: self nargs]' classified: 'accessing'  ProcessFrame understands: 'arguments: nargs | arguments offset i [arguments _ Vector new: nargs. offset _ bp + dOffsetArgs + nargs. for i to: nargs do [arguments  i _ process  (offset - i)].  arguments]'  nil installError  -------------------------------------------------------------------------------- /updates/0250doit-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix receiver in debugger code pane. Prevent error when printing thisContext current'  ProcessFrame understands: 'message | method t2 [self hasCaller and nil  (process  (bp + dOffsetBPDelta))  [method _ process  (self callerBP + dOffsetMethod). method messageAt: self callerPC] XXnoCallerXX]' classified: 'Accessing'  StackPane understands: 'execute: parseStream for: codePane [proceed2 _ codePane execute: parseStream in: [selection=0 [false] listselection] to: [selection=0 [nil] (listselection) receiver]]'  -------------------------------------------------------------------------------- /updates/0251ProcessOrgs-di.st: -------------------------------------------------------------------------------- 1 | Process organization fromParagraph: '''NoteTaker processes were designed to take advantage of the 8086 stack. The stack grows downward in memory, the stack frames are set up like the 8086, and the frames overlap with the stack top of one frame being the receiver and args of the next. Note that the stack pointer and pc are internal to the VM, and are only accessible when a .thisContext. bytecode causes them to be written to the stack and the stack pointer to be recorded in top. The stack pointer is recorded relative to the end of the process so that it will remain valid if the process needs to be expanded.'' (''init-restart'' goBaby init restart run send:to: send:to:withArgs: setRestart ) (''VM operation'' pop popN: push: ) (''control'' current eval remoteCopy ) (''testing'' bounceBackTest: ) (''private'' hash topIndex topIndex_ )' asParagraph for: Process  ProcessFrame organization fromParagraph: '''A ProcessFrame is an outrigger on a process, providing the ability to identify stack frames and their individula fields. The NoteTaker frames are only linked back from callee to caller, but a more laborious traversal forward is possible using the logic in successor.'' (''initialize'' classInit from: process:bp: ) (''context access'' arguments arguments: mclass message method nargs pc receiver sender tempframe temps ) (''frame access'' caller callerBP callerPC hasCaller stack successor thisop ) (''debugger access'' climb resume:with: variableNamesInto:with: ) (''accessing'' bp process ) (''printing'' printon: )' asParagraph for: ProcessFrame  RemoteCode organization fromParagraph: '''In order to handle Smalltalk-76 remote code (predecessor to blocks) outrigger RemoteCode instances allowed code evaluation to be controlled by, and to return to, code other than its sender.'' (''accessing'' frameOffset ) (''control'' eval value value_ )' asParagraph for: RemoteCode  -------------------------------------------------------------------------------- /updates/0252framePrinting-bf.st: -------------------------------------------------------------------------------- 1 | 'More robust frame printing'  ProcessFrame understands: 'message | method [self hasCaller  [method _ process  (self callerBP + dOffsetMethod). method messageAt: self callerPC] XXnoCallerXX]' classified: 'context access'  ProcessFrame understands: 'printon: strm [(self validFrameAt: bp)  false  [process  thisContext  [strm append: ''thisContext''; print: bp] strm append: ''a ProcessFrame'']. self hasCaller  [strm append: self mclass title. [self receiver is: self mclass  [] strm append: ''('' + self receiver class title + '')'']. strm append: '' <= ''. strm print: self message] "Root method - maybe search for method in class..." strm append: self receiver class title + '' <= '' + ''root method'']' classified: 'printing'  ProcessFrame understands: 'successor | limit pi ["Crawl forward in the stack looking for the next viable processFrame" limit _ process topIndex. pi _ bp - 1. "Process index" while pi  limit do [[process  (pi + dOffsetBPDelta) is: Integer  [process  (pi + dOffsetBPDelta) = (bp - pi - 1)  [process  (pi + dOffsetCallersPC) is: Integer  [process  (pi + dOffsetNrArgs) is: Integer  [process  (pi + dOffsetMethod) is: CompiledMethod  [process  (pi + dOffsetMethodClass) Is: Class  [ProcessFrame new process: process bp: pi]]]]]]]. pi _ pi - 1]. nil]' classified: 'frame access'  ProcessFrame understands: 'validFrameAt: pi [[process  (pi + dOffsetBPDelta) is: Integer  [process  (pi + dOffsetCallersPC) is: Integer  [process  (pi + dOffsetNrArgs) is: Integer  [process  (pi + dOffsetMethod) is: CompiledMethod  [process  (pi + dOffsetMethodClass) Is: Class  [true]]]]]]. false]' classified: 'frame access'  -------------------------------------------------------------------------------- /updates/0253notifierFrames-bf.st: -------------------------------------------------------------------------------- 1 | 'Skip uninteresting frames in notifier'  UserView understands: 'notifyNT: msg | notifier frame [NotifyFlag  [notifier _ NotifyWindowNT new. frame _ thisContext current caller caller. "skip notifyNT: and notify:" [msg = ''user interrupt''  [frame _ frame caller]]. "skip error:" notifier title: msg processFrame: frame. NormalCursor topage1. self schedule: notifier; run: true] self clearshow: msg; cr; show: ''ctl-d to restart''. self ev. thisContext restart]'  -------------------------------------------------------------------------------- /updates/0254cacheWindowBits-bf.st: -------------------------------------------------------------------------------- 1 | 'Add global CacheWindowBits flag'  Smalltalk declare: CacheWindowBits as: false  Window understands: 'frame: r | ext [if frame  nil then [ext _ frame extent]. frame _ self fixframe: r. if ext  frame extent then [self forgetBits]]'  Window understands: 'grabBits [bits _ [CacheWindowBits  [frame bitsIntoString]]]'  Window understands: 'newframe | pos rect [user waitnobug. [frame  nil  [] self aboutToFrame]. pos _ OriginCursor showwhile [user waitbug]. growing _ true. frame _ self fixframe: (pos rect: pos + 32). frame boxcomp. CornerCursor showwhile [while [pos _ user mpnext. pos] do [[rect  nil  [user cursorloc_ pos max: frame corner]]. rect _ frame copy. frame boxcomp. frame _ self fixframe: (frame growto: pos). frame boxcomp]]. frame boxcomp. self frame: frame. growing _ false. self takeCursor]'  Window understands: 'resize | rect [rect _ self resizeHotspot. until user anybug do [ user kbck  [ "pressed key, reframe by keyboard" frame boxcomp. until user anybug do [ user kbdnext = 193  [self resizeBy: 10. frame boxcomp]; = 194  [self resizeBy: 10. frame boxcomp]; = 195  [self resizeBy: 01. frame boxcomp]; = 196  [self resizeBy: 01. frame boxcomp];  false  [frame boxcomp]]. frame boxcomp. user waitnobug]. (rect has: user mp)  false  [false]]. self aboutToFrame. rect _ frame copy. frame boxcomp. until user nobug do [ frame corner  user mp  [ frame boxcomp. self frame: (frame growto: user mp). frame boxcomp]]. frame boxcomp. user restore]' classified: 'framing'  -------------------------------------------------------------------------------- /updates/0257reposFix-bf.st: -------------------------------------------------------------------------------- 1 | 'Prevent repositioning CodePane (which inherits repositionOrResize)'  CodePane understands: 'repositionOrResize [false]'  Window understands: 'reposition | hotspot [hotspot _ self repositionHotspot. "wait for user to click or use keyboard" until user anybug do [ user kbck  [ "pressed key, reframe by keyboard" frame boxcomp. until user anybug do [ user kbdnext = 193  [self repositionBy: 10. frame boxcomp]; = 194  [self repositionBy: 10. frame boxcomp]; = 195  [self repositionBy: 01. frame boxcomp]; = 196  [self repositionBy: 01. frame boxcomp];  false  [frame boxcomp]]. frame boxcomp. user waitnobug]. (hotspot has: user mp)  false  [false]]. "clicked, reframe by mouse" frame boxcomp. until user nobug do [ frame origin  user mp  [ frame boxcomp. frame moveto: user mp. frame boxcomp]]. frame boxcomp. self frame: frame. user restore]' classified: 'framing'  Window understands: 'resize | hotspot [hotspot _ self resizeHotspot. until user anybug do [ user kbck  [ "pressed key, reframe by keyboard" frame boxcomp. until user anybug do [ user kbdnext = 193  [self resizeBy: 10. frame boxcomp]; = 194  [self resizeBy: 10. frame boxcomp]; = 195  [self resizeBy: 01. frame boxcomp]; = 196  [self resizeBy: 01. frame boxcomp];  false  [frame boxcomp]]. frame boxcomp. user waitnobug]. (hotspot has: user mp)  false  [false]]. self aboutToFrame. frame boxcomp. until user nobug do [ frame corner  user mp  [ frame boxcomp. self frame: (frame growto: user mp). frame boxcomp]]. frame boxcomp. user restore]' classified: 'framing'  -------------------------------------------------------------------------------- /updates/0258Window-frame-.st: -------------------------------------------------------------------------------- 1 | Window understands: 'frame: r | ext [if nil  frame then [ext _ frame extent]. frame _ self fixframe: r. if ext  frame extent then [self forgetBits]]' classified: 'as yet unclassified' -------------------------------------------------------------------------------- /updates/0261projectEnter-bf.st: -------------------------------------------------------------------------------- 1 | 'Make top window active when entering project'  UserView understands: 'install [background _ color. [sched length > 0  [beTopWindow _ sched1]]. self screenextent: screenrect extent tab: htab  vtab]' classified: 'install / exit'  UserView understands: 'run: topFlag | i w forward "topFlag means sched1 already is awake" [forward _ [topFlag [w_sched1. while w eachtime do []. w lasttime] true]. restartRequested _ false. until restartRequested do [i_0. [forward or sched length = 0  [] self toBottom: w. beTopWindow _ sched1]. until [(i_i+1) > sched length[] w _ schedi. w inactive  [false] w firsttime] do [self runTicks] i>sched length "check for bug in empty space" [user yellowbugelf bugScreenMenu]. user shiftKeyelf recognize]] sched promote: w. while w eachtime do [self runTicks] forward _ w lasttime. beTopWindow _ nil]]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0263charForm-bf.st: -------------------------------------------------------------------------------- 1 | 'Allow changing character width when editing a font'  Font understands: 'charForm: charix _ charForm | ascii [ascii _ charix. [(ascii between: minascii and: maxascii)  falsescii _ maxascii + 1]]. [charForm width  (self widthof: ascii)  [self widthof: ascii _ charForm width]]. charForm displayat: xtable(ascii+1)0 in: self glyphsForm]' classified: 'as yet unclassified'  Font understands: 'widthof: c _ w | leftX rightX delta newRaster oldForm newForm i [leftX _ xtable(c+1). rightX _ xtable(c+2). delta _ w - (rightX - leftX). newRaster _ xtable last + delta + 15 / 16. oldForm _ self glyphsForm. newForm _ [raster = newRaster  [oldForm] raster _ newRaster. glyphs _ String new: self byteraster * self height. self glyphsForm]. oldForm copy: (00 rect: rightXself height) to: 00 in: newForm. oldForm copy: (rightX0 rect: xtable lastself height) to: rightX+delta0 in: newForm. for i from: c+2 to: xtable length do [xtablei _ xtablei + delta]. maxwidth _ maxwidth max: w]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0264formMenu-bf.st: -------------------------------------------------------------------------------- 1 | 'Changel "edit" to "repaint" in FormWindow menu'  FormWindow understands: 'yellowbug | choices choice [choices _ (''repaint'' ''dst _ src'' ''dst or src'' ''dst xor src'' ''dst and src'' ''dst _ ~src'' ''dst or ~src'' ''dst xor ~src'' ''dst and ~src'' ''reflow'') copy. choice _ effect + 2. choiceschoice _ '' '' + (choiceschoice) + '' ''. [self style: reflow  [choices10 _ '' '' + (choices10) + '' '']]. choice _ (Menu new stringFromVector: choices) bug. choice = 0  [] choice = 1  [form edit] choice = 10  [self style: reflow _ (self style: reflow)  false. self frame: frame. user restore] effect _ choice - 2. (effect land: 3)  0  "set transparent fill" [[(self style: fill) = white  [self style: fill _ nil]]. user restore: frame] self show]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0265topWindowFix-bf.st: -------------------------------------------------------------------------------- 1 | 'Fix top window if scheduler is empty'  UserView understands: 'topWindow [sched length = 0  [nil] sched  1]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0268formEdit-bf.st: -------------------------------------------------------------------------------- 1 | 'Make form repaint on top of form window (plus fix a couple problems)'  BitRectEditor understands: 'fixframe: r [r origin _ r origin | 2. picture moveto: r origin. r corner _ picture corner. r]' classified: 'as yet unclassified'  BitRectEditor understands: 'leave [[dirty  [self writeToForm]]. self style: mondoFrame  [user restore: self mondoFrame. self showtitle]. [nilsaveActionPic[] actionpic bitsFromString: saveActionPic. saveActionPic _ nil.]. [nil saveToolPic[] toolpic bitsFromString: saveToolPic. saveToolPic _ nil]. ]' classified: 'as yet unclassified'  Form understands: 'edit "Form fromuser edit." [self editIn: (Rectangle fromuser origin extent: self extent)]' classified: 'editing'  Form understands: 'editIn: frame | ed "Form fromuser edit." [user leaveTop. ed _ BitRectEditor new picture: (BitRect new readFromForm: self). ed formUnderEdit: self. ed frame: frame; show. user restartup: ed]'  FormWindow understands: 'yellowbug | choices choice [choices _ (''repaint'' ''dst _ src'' ''dst or src'' ''dst xor src'' ''dst and src'' ''dst _ ~src'' ''dst or ~src'' ''dst xor ~src'' ''dst and ~src'' ''reflow'') copy. choice _ effect + 2. choiceschoice _ '' '' + (choiceschoice) + '' ''. [self style: reflow  [choices10 _ '' '' + (choices10) + '' '']]. choice _ (Menu new stringFromVector: choices) bug. choice = 0  [] choice = 1  [form editIn: frame copy] choice = 10  [self style: reflow _ (self style: reflow)  false. self frame: frame. user restore] effect _ choice - 2. (effect land: 3)  0  "set transparent fill" [[(self style: fill) = white  [self style: fill _ nil]]. user restore: frame] self show]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0271fontAsStrike-bf.st: -------------------------------------------------------------------------------- 1 | 'Filout support for a font. Also, load extended Palatino25 font with the code chars.'  Font understands: 'asStrike | s i [(s _ Stream default) nextword _ 0100000; nextword _ minascii; nextword _ maxascii; nextword _ maxwidth; nextword _ length; nextword _ ascent; nextword _ descent; nextword _ xoffset; nextword _ raster; append: glyphs. for i from: minascii + 1 to: maxascii + 3 do [s nextword _ xtable  i]. s contents]'  DefaultTextStyle fontset  6 _ Font new fromStrike: 'Palatino25' stream: (user fileString: updateURL + 'Palatino25.strike') asStream.  -------------------------------------------------------------------------------- /updates/0272extentOfPigTailArrow-yo.st: -------------------------------------------------------------------------------- 1 | UserView understands: 'recognizeStroke: stroke | result ps cls d r [ps _ stroke points. stroke preProcess. result _ self recognizer recognizeStroke: stroke. [(result  1) = ''star''  [cls _ StarWindow]; = ''circle''  [cls _ EllipseWindow]; = ''arrow''  [cls _ ArrowWindow]]. [nil  cls  [ user schedule: (cls new setBounds: (Rectangle new encompass: ps))] (result  1) = ''rectangle''  [ d _ D1TopWindow new setBounds: (Rectangle new encompass: ps). d style: noTitle _ true. d text: ''''. d alignment: 2. user schedule: d] (result  1) = ''downarrow''  [ user scheduleOnBottom: (ArrowWindow new setBoundsForDownPointing: (Rectangle new encompass: ps)). r _ Rectangle new encompass: ps. d _ D1TopWindow new setBounds: ((r center - (14018)) extent: 28035). d style: noTitle _ true. d text: ''''. d alignment: 2. user schedule: d]]]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0274deleteDeleteGesture-yo.st: -------------------------------------------------------------------------------- 1 | ShapeWindow understands: 'eachtime | name [for name from: self controlPoints do [ (self pointHotspot: style  name) has: user mp  [self crossHairCursor showwhile [self pointMove: name]. true]]. [user shiftKey[ false]]. super eachtime]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0275arrowFix-yobf.st: -------------------------------------------------------------------------------- 1 | 'Fix labeled-arrow gesture'  ShapeWindow understands: 'init | pt pos [self reset. self style: fill _ nil; style: borderWidth _ 4; style: noTitle _ true]' classified: 'initialize-release'  UserView understands: 'recognizeStroke: stroke | result ps cls d r arrow [ps _ stroke points. stroke preProcess. result _ self recognizer recognizeStroke: stroke. [(result  1) = ''star''  [cls _ StarWindow]; = ''circle''  [cls _ EllipseWindow]; = ''arrow''  [cls _ ArrowWindow]]. [nil  cls  [ user schedule: (cls new setBounds: (Rectangle new encompass: ps))] (result  1) = ''rectangle''  [ d _ D1TopWindow new setBounds: (Rectangle new encompass: ps). d style: noTitle _ true. d text: ''''. d alignment: 2. user schedule: d] (result  1) = ''downarrow''  [ arrow _ ArrowWindow new. arrow setBoundsForDownPointing: (Rectangle new encompass: ps). arrow show. user schedule: arrow. r _ Rectangle new encompass: ps. d _ D1TopWindow new setBounds: ((r center - (14018)) extent: 28035). d style: noTitle _ true. d text: ''''. d alignment: 2. user schedule: d]]]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0276restartTick-bf.st: -------------------------------------------------------------------------------- 1 | 'Start ticking after restarting image'  UserView understands: 'restartTicks | w [for w from: self allWindowsInAllProjects do [ w style: ticking  [w style: lastTick _ false]]]'  UserView understands: 'save [self currentDisplay: (Form new extent: 11 bits: ''--'' offset: nil). self primSave. self restoredisplay. self restartTicks. self restore]' classified: 'start & finish'  -------------------------------------------------------------------------------- /updates/0279BrowseTweaks-di.st: -------------------------------------------------------------------------------- 1 | BrowseWindow understands: 'browseClass: cl | orgPane selPane codePane [orgPane _ OrganizationPane new. selPane _ SelectorPane new. codePane _ CodePane new. self title: cl title asString with: selPane , codePane at: (0  0 rect: 30  36) , (30  0 rect: 36  36). self newframe. self show. orgPane to: selPane class: cl. selPane from: orgPane to: codePane. codePane from: selPane. selPane of: (cl organization category: ''all'')]'  BrowseWindow understands: 'resize [panes length  2  [ super resize] "If resizing a spawned class, make the codePane a reasonable size" templates _ (0  0 rect: 6  36) , (6  0 rect: 36  36).  super resize]'  OrganizationPane understands: 'code: t1 [ class code: t1]' classified: 'as yet unclassified'  OrganizationPane understands: 'noCode [class  nil  [classPane noCode] classPane  nil  [ ''''] selection  1  [class definition] selection = 2  [class organization] ''Message name and Arguments | Temporary variables "short comment" ["long comment if necessary" Smalltalk Statements]'']' classified: 'as yet unclassified'  SelectorPane understands: 'selected [codePane frame width < 50  [codePane showing: ''''] codePane showing: (organizationPane code: list  selection)]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0280browseInspect-bf.st: -------------------------------------------------------------------------------- 1 | 'BitRectEditor needs "browse" option. Make browse and inspect restart the main loop so the window is active'  BitRectEditor understands: 'bluebug | [ "picture is: BitImage [  picture fromrectangle: (picture rectangle)]" windowmenu bug =1 elf leave. exitflag _ false]; "under" =2 elf leave; newframe; enter]; "move" =3 elf grow "grow"]; =4 elf leave. user unschedule: self. self restore. false]; =5 elf leave. picture filout. self enter]; "filout" =6 elf print]; =7 elf inspect]; =8 elf browseMessages] ]' classified: 'as yet unclassified'  BitRectEditor understands: 'classInit | t i "BitRectEditor classInit." [t _ Vector new: 6. for i to: t length do [ti _ BitRectTool new init]. tools _ (RadioButtons new) vec: t at: 00 width: 20. windowmenu _ Menu new string: ''to bottom move grow close filout printbits inspect browse''. actionpic _ BitRect new filin: updateURL + ''actionpic.pic''. actionpic title _ ''actionpic''. toolpic _ BitRect new filin: updateURL + ''toolpic.pic''. toolpic title _ ''toolpic''. self initmenu1. ]' classified: 'as yet unclassified'  Object understands: 'browseMessages [user leaveTop. user restartup: (BrowseWindow new browseClass: self class)]'  Object understands: 'inspect | insp ext [user leaveTop. user restartup: (InspectWindow new of: self)]' classified: 'user interface'  BitRectEditor classInit  -------------------------------------------------------------------------------- /updates/0281BrowseTweaks2fix-di.st: -------------------------------------------------------------------------------- 1 | BrowseWindow understands: 'fixframe: t1 [panes length  2  [ super fixframe: t1] (templates1) width > (templates2) width  [ Rectangle new origin: t1 origin extent: (t1 extent max: 125  150)]  Rectangle new origin: t1 origin extent: (t1 extent max: 400  150)]'  BrowseWindow understands: 'resize [panes length  2  [ super resize] "If resizing a spawned class, make the codePane a reasonable size" templates _ (0  0 rect: 9  36) , (9  0 rect: 36  36).  super resize]'  PanedWindow understands: 'fixframe: rect [ Rectangle new origin: rect origin extent: (rect extent max: 160  80)]' classified: 'as yet unclassified'  PanedWindow understands: 'frame: newFrame | pane pf strm t5 t6 [frame _ self fixframe: newFrame. strm _ templates asStream. t5 _ frame origin - 1. t6 _ frame extent + 2. for pane from: panes do [pf _ strm next. pane frame_ pf * t6 / 36 + t5 inset: 1]]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0282UndeclaredHelp-di.st: -------------------------------------------------------------------------------- 1 | SymbolTable understands: 'allRefsTo: nameOrNames "Smalltalk allRefsTo: Process" "Note: Undeclared allRefsTo: Context will return all references to an undeclared global, and Undeclared showAllRefs will print all of them in disp" [self allRefsTo: nameOrNames from: Smalltalk allClassNames]' classified: 'as yet unclassified'  SymbolTable understands: 'showAllRefs | name ref "Undeclared showAllRefs." [for name from: self do [user cr; show: name; cr; show: (self allRefsTo: name)]]'  SymbolTable derstands: 'allRefs' unique.  -------------------------------------------------------------------------------- /updates/0283Merge-srcs-fix-tk.st: -------------------------------------------------------------------------------- 1 | Class understands: 'install: sel method: m literals: l code: c backpointers: b | spec log ["If MergingSources is true compare the old decompile to decompiling the new method. If they''re equal, proceed to install and enter in Changes." [MergingSourcestrue and (messagedict has: sel) [(self decompile: sel)(Decompiler new decompile: sel withMethod: m class: self) [m freeLiterals. user cr; show: ''~''+sel.  false] user cr; show: sel]]. "Perform insertion in a copy then install atomically" messagedict _ messagedict copy insert: sel method: m literals: l code: c backpointers: b. Changes insert: (spec _ title + '' '' + sel). if (Changes has: (spec _ ''~'' + spec)) then [Changes delete: spec]. user changeLog log do [self printMethod: sel on: log]]'  -------------------------------------------------------------------------------- /updates/0284MergeSrcs-fix-again-tk.st: -------------------------------------------------------------------------------- 1 | Class understands: 'install: sel method: m literals: l code: c backpointers: b | spec log ["If MergingSources is true compare the old decompile to decompiling the new method. If they''re equal, proceed to install and enter in Changes." [(MergingSourcestrue)  [(messagedict has: sel)  [(self decompile: sel)(Decompiler new decompile: sel withMethod: m class: self) [m freeLiterals. user cr; show: ''~''+sel.  false] user cr; show: sel].  false]]. "Perform insertion in a copy then install atomically" messagedict _ messagedict copy insert: sel method: m literals: l code: c backpointers: b. Changes insert: (spec _ title + '' '' + sel). if (Changes has: (spec _ ''~'' + spec)) then [Changes delete: spec]. user changeLog log do [self printMethod: sel on: log]]'  -------------------------------------------------------------------------------- /updates/0285RecoverFromFilinError-di.st: -------------------------------------------------------------------------------- 1 | Class understands: 'notify: errorString at: position in: stream | para codeWindow codePane [para _ [stream is: Streamtream reset rest] stream]. codeWindow _ CodeWindow new class: self selector: ''error in filin'' para: para formerly: false. user schedule: codeWindow. codePane _ codeWindow  ''panes''  1. codePane notify: errorString at: position in: para]' classified: 'compiler access'  Parser understands: 'from: sourceStrm to: compiler | parserProcess ["Sets up a producer/consumer relation between parser and compiler. OppositeCourt is the process of the compiler and the rest of the UI." source _ sourceStrm. dest _ compiler. oppositeCourt _ thisContext. parserProcess _ Process new: 1000. parserProcess init. parserProcess send: begin to: self. parserProcess eval]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0286CodeWindowPreFrame-di.st: -------------------------------------------------------------------------------- 1 | CodeWindow understands: 'class: cls selector: sel para: para formerly: formerly | pane [pane _ CodePane new class: cls selector: sel para: nil. self title: cls title + '' '' + sel with: pane inVector at: stdTemplates. self frame: (user screenrect center asRectangle inset: 250150). self show. pane showing: para. pane formerly: formerly. pane from: pane]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0287keep-category-tk.st: -------------------------------------------------------------------------------- 1 | Class understands: 'understands: code classified: heading | cat sel "compile and install method" [cat _ heading. heading = false  [ sel _ Generator new pattern: code in: self. cat _ self organization invert: sel. cat = false  [cat _ ''as yet unclassified'']].  Generator new compile: code asParagraph in: self under: cat notifying: self]' classified: 'accessing method dictionary'. Generator understands: 'pattern: sourceString in: aClass "find the selector for this method" [parser _ Parser new. parser from: sourceString asStream to: self. self initSymbols: aClass.  parser pattern: ParsedBlock default]' classified: 'compiled methods'. -------------------------------------------------------------------------------- /updates/0297Source-ok-21-tk.st: -------------------------------------------------------------------------------- 1 | Stream understands: 'append: x | i "Array arg" [for i from: x do [self next _ i]. x]' classified: false  Stream understands: 'dequeue "use it as a FIFO" [self dequeue: 1]' classified: false  -------------------------------------------------------------------------------- /updates/0299benchmarks-bf.st: -------------------------------------------------------------------------------- 1 | 'Add tinyBenchmarks'  Integer understands: 'benchFib "Handy send-heavy benchmark" "(result / seconds to run) = approx calls per second" "| r t . t _ user millisecondsToRun [r _ 20 benchFib]. r * 1000 / t" [self < 2  [1].  (self-1) benchFib + (self-2) benchFib + 1]' classified: 'benchmarks'  Integer understands: 'benchmark | size flags prime k count iter i "Handy bytecode-heavy benchmark" "(500000 / time to run) = approx bytecodes per second" "500000 * 10 * 1000 / (user millisecondsToRun [10 benchmark])" [size _ 8190. for iter to: self do [count _ 0. flags _ (Vector new: size) all_ true. for i to: size do [flags  i  [ prime _ i + 1. k _ i + prime. while [k  size] do [flags  k _ false. k _ k + prime]. count _ count + 1]]].  count]' classified: 'benchmarks'  Integer understands: 'tinyBenchmarks | n1 t1 start n2 t2 "Report the results of running the two tiny benchmarks" "0 tinyBenchmarks" [n1 _ 1. while [t1 _ user millisecondsToRun [n1 benchmark]. t1 < 1000] do [n1 _ n1 * 2]. start _ user ticks. n2 _ 0. while [n2 _ n2 + 20 benchFib. t2 _ user ticks - start. t2 < 1000] do [].  ((n1 * 500000 * 1000) / t1) asString + '' bytecodes/sec; '' + ((n2 * 1000) / t2) asString + '' sends/sec'']' classified: 'benchmarks'  UserView understands: 'millisecondsToRun code | start [start _ self ticks. code eval. self ticks - start]'  UserView derstands: 'ticksToRun' unique.  -------------------------------------------------------------------------------- /updates/0300https-bf.st: -------------------------------------------------------------------------------- 1 | 'Switch update stream to https. NOTE: this update was edited retroactively to reflect the new update stream URL.'  updateURL = 'http://smalltalkzoo.thechm.org/users/codefrau/St78/updates/' pdateURL _ 'https://smalltalkzoo.thechm.org/users/codefrau/St78/updates/']  -------------------------------------------------------------------------------- /updates/0302textsel-bf.st: -------------------------------------------------------------------------------- 1 | 'Restore some comments and var names from St76'  TextImage understands: 'complementfrom: hair1 to: hair2 | temprect ["Complement the screen dots corresponding to the lines and part-lines of the paragraph between hair1 inclusive and hair2 exclusive. If hair1 = hair2, this is a no-op. If hair1 > hair2, they are reversed. This complementing happens in three parts, A, B, and C, between points 1 and 2, according to the following illustration: 1AAA BBBB BBBB BBBB CCC2 unless there is just one line involved, as in: 1DD2 " "one line case" hair1 minY = hair2 minY [((([hair1 minX  hair2 minX [hair1 origin rect: hair2 corner] hair2 origin rect: hair1 corner]) intersect: frame) intersect: window) comp] [hair1 minY > hair2 minY [ temprect _ hair1. hair1 _ hair2. hair2 _ temprect]]. temprect _ (frame minX  hair1 maxY) rect: (frame maxX  hair2 minY). (((hair1 origin rect: (temprect maxX  temprect minY)) intersect: frame) intersect: window) comp. ((temprect intersect: frame) intersect: window) comp. ((((temprect minX  temprect maxY) rect: hair2 corner) intersect: frame) intersect: window) comp. ]' classified: 'selecting'  TextImage understands: 'reversefrom: char1 to: char2| h1 h2 r ["Complement the dots corresponding to the the lines and part-lines of the paragraph between the left edge of char1 and the left edge of char2. If char1 = char2, this is sort of a no-op. If char1 > char2, this is undefined." self pointofchar: char1 andrect r. h1 _ r. [char2=char12 _ h1+ (10)] self pointofchar: char2 andrect r. h2 _ r]. self complementfrom: h1 to: h2]' classified: 'selecting'  -------------------------------------------------------------------------------- /updates/0303cleanMethods-bf.st: -------------------------------------------------------------------------------- 1 | 'Clean out MethodKeeper'  MethodKeeper _ (Vector new: 10) asStream  -------------------------------------------------------------------------------- /updates/0304DansCompRect.st: -------------------------------------------------------------------------------- 1 | 'Dans refactoring of compRect for easy change to selection'  TextImage understands: 'compRect: r ["Reverse the rectangle r from white to black, as part of a selection" ((r intersect: frame) intersect: window) comp ]' classified: 'selecting'  TextImage understands: 'complementfrom: t1 to: t2 | t3 mid ["Reverse the selection from black-on-white to white-on-black" "t1 and t2 are character blocks for beginning and end of the selection" t1 minY = t2 minY  ["selection is all on one line - easy." self compRect: ([t1 minX  t2 minX  [t1 origin rect: t2 corner] t2 origin rect: t1 corner])] [t1 minY > t2 minY  ["ensure t1 is at lesser y" t3 _ t1. t1 _ t2. t2 _ t3]]. "compute the middle block of full lines" mid _ frame minX  t1 maxY rect: frame maxX  t2 minY. "top partial line" self compRect: (t1 origin rect: mid maxX  mid minY). "middle block of full lines" self compRect: mid. "bottom partial line" self compRect: (mid minX  mid maxY rect: t2 corner)]' classified: 'selecting'  -------------------------------------------------------------------------------- /updates/0305editFileName-bf.st: -------------------------------------------------------------------------------- 1 | 'when editing a file, click window title to change file name'  CodeWindow understands: 'editTitle [super editTitle. panes1 canunderstand: fileName:  [panes1 fileName: titlepara text]]'  -------------------------------------------------------------------------------- /updates/0306doNotKeepMethod-bf.st: -------------------------------------------------------------------------------- 1 | 'Do not keep methods in MethodKeeper'. MethodKeeper _ (Vector new: 10) asStream  CompiledMethod understands: 'free [self refct > 2  ["MethodKeeper next_ self"] "not needed on JS VM" self freeLiterals]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0307pigtailWindow-bf.st: -------------------------------------------------------------------------------- 1 | 'Do a pigtail gesture to open workspace with prompt'  PanedWindow understands: 'title: t1 with: panes at: paneRects | p [[t1  [title _ t1] title _ ''foo''. self style: noTitle _ true]. panes _ panes. templates _ paneRects. self reset. for p from: panes do [p init]]' classified: 'as yet unclassified'  UserView understands: 'recognizeStroke: stroke | result ps cls d r arrow para [ps _ stroke points. stroke preProcess. result _ self recognizer recognizeStroke: stroke. [(result  1) = ''star''  [cls _ StarWindow]; = ''circle''  [cls _ EllipseWindow]; = ''arrow''  [cls _ ArrowWindow]]. [nil  cls  [ user schedule: (cls new setBounds: (Rectangle new encompass: ps))] (result  1) = ''rectangle''  [ d _ D1TopWindow new setBounds: (Rectangle new encompass: ps). d style: noTitle _ true. d text: ''''. d alignment: 2. user schedule: d] (result  1) = ''downarrow''  [ arrow _ ArrowWindow new. arrow setBoundsForDownPointing: (Rectangle new encompass: ps). arrow show. user schedule: arrow. r _ Rectangle new encompass: ps. d _ D1TopWindow new setBounds: ((r center - (14018)) extent: 28035). d style: noTitle _ true. d text: ''''. d alignment: 2. user schedule: d]. (result  1) = ''pigtail''  [ para _ '' ''. para1 _ 20. "cannot put prompt char in code" d _ CodeWindow new title: false para: para inFrame: (Rectangle new encompass: ps). d editor select: 3. user schedule: d]]]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0310workspaceExtent-bf.st: -------------------------------------------------------------------------------- 1 | 'Allow workspace to be much smaller'  CodeWindow understands: 'fixframe: rect [ Rectangle new origin: rect origin extent: (rect extent max: 69  16)]'  -------------------------------------------------------------------------------- /updates/0312drawingFeb15-yo.st: -------------------------------------------------------------------------------- 1 | Class new title: DrawingWindow subclassof: ShapeWindow fields: 'strokes' declare: ''; classified: 'Windows'  DrawingWindow understands: 'controlPoints [ ()]'  DrawingWindow understands: 'draw: function | i j s b t ps [j _ 1. while (j  strokes length) do [ s _ strokes  j. ps _ s points. b _ ps  1. t _ self turtle: function. t place: b. i _ 2. while (i  ps length) do [ t goto: (ps  i). i _ i + 1]. j _ j + 1]]'  DrawingWindow understands: 'strokes: aVector rect: rect [strokes _ aVector. self style: rect _ rect. frame _ rect]'  UserView understands: 'draw | strokes stroke win rect [strokes _ Stream new of: (Vector new: 4). rect _ Rectangle new origin: 00 corner: 00. [RecogCursor showwhile [ while user ctrlKey do [ user anybug  [ stroke _ D1Stroke fromuser. stroke points length > 0  [strokes next_ stroke]]. stroke  nil  [ rect _ Rectangle new encompass: (rect corners + stroke points)]]]]. stroke  [ win _ DrawingWindow new. win setBounds: rect. win strokes: strokes contents rect: rect. user schedule: win]]' classified: 'as yet unclassified'  UserView understands: 'run: topFlag | i w forward "topFlag means sched1 already is awake" [forward _ [topFlag [w_sched1. while w eachtime do []. w lasttime] true]. restartRequested _ false. until restartRequested do [i_0. [forward or sched length = 0  [] self toBottom: w. beTopWindow _ sched1]. until [(i_i+1) > sched length[] w _ schedi. w inactive  [false] w firsttime] do [self runTicks] i>sched length "check for bug in empty space" [user yellowbugelf bugScreenMenu]. user ctrlKey  [self draw]. user shiftKeyelf recognize]] sched promote: w. while w eachtime do [self runTicks] forward _ w lasttime. beTopWindow _ nil]]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0313AmenddrawingFeb15-yo.st: -------------------------------------------------------------------------------- 1 | D1Stroke understands: 'fromuser | bits pen a last current [pen _ Turtle init. pen color: dkgray. pen width: 4. a _ Stream new of: (Vector new: 20). last _ user waitbug. a next _ last. bits _ user screenrect bitsIntoString. pen place: last. while user anybug do [ current _ user mp. [last  current  [ a next _ current. pen goto: current. last _ current]]]. user screenrect bitsFromString: bits. a contents length  1  [false] self points: a contents]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0314Amend2drawingFeb15-yo.st: -------------------------------------------------------------------------------- 1 | UserView understands: 'draw | strokes stroke win rect points [strokes _ Stream new of: (Vector new: 4). rect _ nil. [RecogCursor showwhile [ while user ctrlKey do [ user anybug  [ stroke _ D1Stroke fromuser. stroke points length > 0  [strokes next_ stroke]]. nil  stroke  [ points _ stroke points. [nil  rect  [points _ rect corners + points]]. rect _ Rectangle new encompass: points]]]]. stroke  [ win _ DrawingWindow new. win setBounds: rect. win strokes: strokes contents rect: rect. user schedule: win]]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0315ProjectDuplicate-di.st: -------------------------------------------------------------------------------- 1 | 'You must open a new project sorter. Old ones will not work right.'  Class new title: ProjectSorter subclassof: PanedWindow fields: 'namesInOrder currentIndex' declare: 'stdTemplates '; classified: 'Windows'  ProjectPane understands: 'yellowbug | editmenu choice [selection = 0  [] scrollBar hidewhile [choice _ (Menu new string: ''visit '' + (listselection) + '' duplicate remove'') bug]. choice = 1  [sorter visit: selection]. choice = 2  ["Duplicate this item and inform the sorter" list _ list replace: selection to: selection-1 by: (listselection) inVector. self of: list. sorter namesInOrder: list]. choice = 3  ["Remove this item and inform the sorter" list _ list replace: selection to: selection by: (Vector new: 0). self of: list. sorter namesInOrder: list]. ]'  ProjectSorter understands: 'visit: index [currentIndex _ index. (self  index) install]' classified: 'as yet unclassified'  ProjectSorter understands: 'visitNext | next [next _ currentIndex + 1 min: self namesInOrder length. self visit: next. ]' classified: 'as yet unclassified'  ProjectSorter understands: 'visitPrevious | next [next _ currentIndex - 1 max: 1. self visit: next]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0316ProjectSorterFix-di.st: -------------------------------------------------------------------------------- 1 | 'Ensure that currentIndex is set when a new ProjectSorter gets opened.' ProjectSorter understands: 'init | pane [pane _ ProjectPane new. self title: ''ProjectSorter'' with: pane inVector at: stdTemplates. self newframe. self show. self validateNames. currentIndex _ self namesInOrder find: self current. pane of: namesInOrder. pane sorter: self. Smalltalk declare: projectSequencer as: self]' classified: 'initialize-release'  -------------------------------------------------------------------------------- /updates/0320copyglyphs-bf.st: -------------------------------------------------------------------------------- 1 | 'Copy missing glyphs to fonts that don''t have them'  FontSet understands: 'copyGlyphs | i target source c src tgt x y [for i from: (1 2 3 4 5 7 8 9 10 11 13 14 15) do [ target _ selfi. source _ self[target height  (self6) height  [6] 0]. for c from: ''' + 30 inString + '_'' do [ src _ source charForm: c. tgt _ Form new extent: (src width * target height / source height)  target height. x _ (tgt width - src width) / 2 max: 0. y _ (target ascent - source ascent) / 2 max: 0. src copy: (00 extent: src extent) to: xy in: tgt. target charForm: c _ tgt]]]' classified: 'as yet unclassified'  DefaultTextStyle fontset copyGlyphs  FontSet derstands: copyGlyphs  -------------------------------------------------------------------------------- /updates/0321ScriptHolder-etc-di.st: -------------------------------------------------------------------------------- 1 | 'Defines ScriptHolder, and S, a global ScriptHolder instance' Class new title: ScriptHolder subclassof: Object fields: '' declare: ''; classified: 'As yet unclassified'  Smalltalk declare: S as: ScriptHolder new  Date understands: 'weekday [ " ''Today is '' + user today weekday " (Tuesday Wednesday Thursday Friday Saturday Sunday Monday) self weekdayIndex]'  Date understands: 'weekdayIndex | a d [ [day  (self monthday: 3) [ a _ year-1. d _ 306] a _ year. d _ 59 - self leap]. "Tuesday=1,..., Monday=7" d + day + a + (a/4) + (a/400) - (a/100) \ 7 + 1]'  SymbolTable understands: 'allGlobals | globs table s " Smalltalk allGlobals inspect " "return an array of names of non-classes in me" [table _ SymbolTable new init: 10. globs _ self contents all s suchThat [(selfs Is: Class)false]. table declare: globs as: (globs transform s to [selfs]).  table]' classified: 'as yet unclassified'  ' Today is ' + user today weekday  -------------------------------------------------------------------------------- /updates/0322SymbolTable-allGlobals.st: -------------------------------------------------------------------------------- 1 | ' Make browse-references work with allGlobals'  SymbolTable understands: 'allGlobals | globs table s " Smalltalk allGlobals inspect " "return an array of names of non-classes in me" [table _ SymbolTable new init: 10. globs _ self contents all s suchThat [(selfs Is: Class)false]. "The copied table must share the same objectReferences" for s from: globs do [table insert: s withref: (self ref: s)].  table]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0327updates-bf.st: -------------------------------------------------------------------------------- 1 | 'Show error if update file not found'  UserView understands: 'filin: filename | file chunk result [file _ self fileString: filename. file  nil  [self cr; show: filename + '' is absent.''. false] self cr; show: ''Reading '' + filename. file _ file asStream. FilinSource _ self. until file end do [chunk _ file upto: 30. result _ nil  chunk. "eval chunk" [result is: String  [self space; show: result] self show: ''.'']. file peek = 26  [file skipTo: ''\''  1. file skipTo: ''g''  1]]. self show: '' ''; cr. FilinSource _ nil. true]' classified: 'file stuff'  UserView understands: 'loadUpdates [self loadUpdatesThrough: 99999]' classified: 'file stuff'  UserView understands: 'loadUpdatesThrough: N "user loadUpdatesThrough: 312" | allUpdates beforeLevel beforeChanges ok [Object allInstances. "force GC" beforeLevel _ updateLevel. beforeChanges _ Changes copy. allUpdates _ self updatesAvailable. ok _ true. while updateLevel < (N min: allUpdates length) do [ok _ self filin: updateURL + (allUpdates  (updateLevel + 1)). ok = false  [ self cr; show: ''ERROR loading '' + (allUpdates  (updateLevel + 1)). N _ 0] updateLevel _ updateLevel + 1. Object allInstances "force GC"]. Changes init copyfrom: beforeChanges. self cr; show: [beforeLevel = updateLevel  [''No''] (updateLevel - beforeLevel) asString]; show: '' new updates loaded. updateLevel '' + updateLevel asString; cr]' classified: 'file stuff'  -------------------------------------------------------------------------------- /updates/0328dirMenu-bf.st: -------------------------------------------------------------------------------- 1 | 'Allow to shift-click a file menu entry to enter that directory'  UserView understands: 'fileMenu: label directory: directory matching: match | fileNames index selected [[self shiftKey  [ "if shift pressed, use server/local instead of default" directory = ''''  [directory _ updateURL] directory _ '''']]. while true do [ fileNames _ user fileStrings: directory matching: match. index _ (Menu new stringFromVector: fileNames , ('' cancel '' + label + '' '')) fbug. index < 1 or index > fileNames length  [false] selected _ directory + (fileNames  index). self shiftKey  [directory _ selected + ''/''] selected]]' classified: 'file stuff'  -------------------------------------------------------------------------------- /updates/0329codefrau.st: -------------------------------------------------------------------------------- 1 | | w s p . for w from: user allWindowsInAllProjects do [ w canunderstand: editor  [ s _ w editor text. p _ s findString: 'Bert,' startingAt: 1. p > 400  [ user show: p asString; cr. w editor selectRange: (p to: p+4); replace: 'Vanessa'; select: 20 ] ] ]  -------------------------------------------------------------------------------- /updates/0330titleEditsFilename-vaf.st: -------------------------------------------------------------------------------- 1 | CodeWindow understands: 'editTitle [super editTitle. ((panes1) canunderstand: fileName:)  [ (panes1) fileName: title]. ]'  -------------------------------------------------------------------------------- /updates/0333OpaqueForm.st: -------------------------------------------------------------------------------- 1 | Class new title: OpaqueForm subclassof: Form fields: 'mask' declare: ''; classified: 'Graphical Objects'  OpaqueForm understands: 'displayat: pt in: destForm [mask displayat: pt effect: compSource+anding "erase mode" in: destForm. self displayat: pt effect: oring in: destForm]'  OpaqueForm understands: 'mask: maskForm [mask _ maskForm]'  -------------------------------------------------------------------------------- /updates/0358TextScrollFix.st: -------------------------------------------------------------------------------- 1 | 'Changes from (31 March 2023 12:19:03 pm )' CodePane understands: 'kbd | key [key _ user kbck. key = 130 or (pared hasPrompt and key = 13)  [user kbd. user shiftKey  [pared extendPrompt] self doit] key = 138  [user kbd. self compile] key = 151  "cut needs to do a copy first" [pared copyselection; typing] key = 165  [user kbd. self cancel] pared typing]' classified: 'as yet unclassified'  D1TextPane understands: 'eachtime [ user kbck [self kbd. self show] frame has: user mp [ user shiftKey  [ RecogCursor showwhile [ while user shiftKey do [ user redbug  [self recognize]]]] user anybug [ user redbug [self redbug] user yellowbug [self yellowbug] user bluebug [false]] user anykeys [self keyset]] self outside]' classified: 'as yet unclassified'  Textframe understands: 'clearfrom: y [((frame origin x  y rect: frame rightsidewindow bottom) intersect: window) clear: [bg  nil  [background] bg]]' classified: 'as yet unclassified'  TextImage understands: 'scrollby: nLines | saveWindow deltaY [deltaY _ nLines * self lineheight max: self frameoffset. frame moveby: 0  (0 - deltaY). true  [self show; select] "Override the fancy overlap Blt stuff" deltaY abs  window height  [self show; select] "No overlap to Blt in this case" "The following code (overridden above) Blts what it can without actual display" "Sadly a bug in displayall causes it to mess up synthetic fonts" saveWindow _ window. window _ [deltaY < 0  [window inset: 0  0 and: 0  (0 - deltaY)] window inset: 0  deltaY and: 0  0]. window blt: window origin - (0  deltaY) mode: storing. [deltaY < 0  [window corner y_ window origin y - deltaY] window origin y_ window corner y - deltaY]. self displayall. self select. window _ saveWindow]' classified: 'as yet unclassified'  -------------------------------------------------------------------------------- /updates/0364filemenu-vaf.st: -------------------------------------------------------------------------------- 1 | 'Changes from (12 January 2024 12:56:13 am )' FileNamePane understands: 'setDirectory [(Menu new stringFromVector: (''Use "copy" in text to set this directory choice...'', self clipboardString, ''default'', '' cancel '') ) fbug =2irectory _ TextImage new primClipboard. self update]; =3irectory _ ''''. self update] ]'  FileNamePane understands: 'setFilter [(Menu new stringFromVector: (''Use "copy" in text to set this filter choice...'', self clipboardString, ''* (all files)'', '' cancel '') ) fbug =2ilter _ TextImage new primClipboard. self update]; =3ilter _ ''*''. self update] ]'  FileNamePane understands: 'yellowbug | menu fileName file [[selection > 0ileName _ listselection]]. menu _ Menu new string: ''filein delete publish as update open as a form  set directory set filter refresh directrory''. scrollBar hidewhile [menu bug = 1  [selection = 0  [window flash] user filin: directory+fileName]; = 2  [selection = 0  [window flash] user confirm: ''Really delete ''+ directory+fileName [user fileString: directory+fileName_ nil. self update]]; = 3  [selection = 0  [window flash] file _ user fileString: directory+fileName. user fileString: (user update: fileName _ file) _ file. user fileString: directory+fileName _ nil. self update]; = 4  [selection = 0  [window flash] user schedule: (user loadFormWindow: directory+fileName)]; = 5  [window flash]; = 6  [self setDirectory]; = 7  [self setFilter]; = 8  [self update] ] ]'  -------------------------------------------------------------------------------- /updates/0365object-recategorization-ff.st: -------------------------------------------------------------------------------- 1 | "Changes Object's categories to those of ST76" 'Changes from (11 January 2024 6:50:03 pm )' Object organization fromParagraph: '''Object is the superclass of all classes. It is an abstract class, meaning that it has no state, and its main function is to provide a foundation message protocol for its subclasses. Three instances of this class are defined: nil, true, and false.'' (''Comparison''     = and and: empty eqv: or or: sameAs: xor: ) (''Classification'' class is: Is: isArray isnt: Isnt: isNumber ) (''Construction'' , asParagraph asStream asVector copy inVector recopy ) (''Aspects'' asOop canunderstand: error: fields hash inspect inspectfield: instfield: instfield:_ instfields itself ref: subError title ) (''Printing'' asFullString asString filout fullprint fullprinton: print printon: ) (''Compiler Defaults''  argsOff: asRemoteCode: emitForEffect:on: emitForTruth:falsity:into:on: emitForValue:on: emitsLoad emittedReceiver emittedVariable findMacros:compilerTemps: firstPush interactive isField notify:at:in: notify:at:in:for: printon:indent:precedence:forValue:decompiler: remote: returns sizeForEffect: sizeForTruth:falsity: sizeForValue ) (''System Primitives'' error installError messageNotUnderstood:withArgs:from: perform: perform:with: perform:with:with: perform:with:with:with: perform:withArgs: performDangerously: performDangerously:with: performDangerously:with:with: performDangerously:with:with:with: performDangerously:withArgs: PTR refct startup swap ) (''As yet unclassified'' become: browseMessages growTo: inspectWithTitle: inspectWithTitle:autoselect: learn: nonliteral )' asParagraph for: Object  -------------------------------------------------------------------------------- /updates/0366filepreview-vaf.st: -------------------------------------------------------------------------------- 1 | 'Preview strike fonts in file browser' FileNamePane understands: 'selected | fileName valueString form box scale i [fileName _ directory + self value. valueString _ user fileString: fileName. [(fileName endsWith: ''.form'') [form _ Form new fromInstance: valueString asStream] (fileName endsWith: ''.pic'') [form _ (BitRect new filin: fileName) asForm] (fileName endsWith: ''.strike'') [form _ (Font new fromStrike: fileName stream: valueString asStream) glyphsForm]  valuePane showing: valueString]. [box _ valuePane frame. form extent  box extent [preview _ form] (fileName endsWith: ''.strike'')  ["wrap glyphs" preview _ Form new extent: box extent. for i from: 0 to: form width / preview width do [ form copy: (preview width * i0 extent: preview widthform height) to: (0(i*form height)) in: preview]] "Shrink if necessary" scale _ (form width asFloat / box width) max: (form height asFloat / box height). scale _ (scale+1 roundTo: 1) asInteger. preview _ form scaledDown: scale]. valuePane showing: nil. preview displayat: valuePane frame origin]'  -------------------------------------------------------------------------------- /updates/0368filebrowser-vaf.st: -------------------------------------------------------------------------------- 1 | 'Fix file browser saving, and show dir+filter in window title' FileNamePane understands: 'compile: paragr | fileName [fileName _ self value. user fileString: directory+fileName _ paragr text]'  FileNamePane understands: 'update | win fileStrings [fileStrings _ user fileStrings: directory matching: filter. "awful hack to get at the dictionary being inspected:" win _ user topWindow. "Where there''s a will there''s a way" win inspectee init: 4; insertall: fileStrings. self of: fileStrings sort. win title_ ''Files matching '' + directory + filter. win showtitle ]'  -------------------------------------------------------------------------------- /updates/0369fixCharRecog-vaf.st: -------------------------------------------------------------------------------- 1 | 'Changes from (10 February 2025 11:18:13 pm )' UserView understands: 'draw | strokes stroke win rect points [strokes _ Stream new of: (Vector new: 4). rect _ nil. [RecogCursor showwhile [ while user ctrlKey do [ user anybug  [ stroke _ D1Stroke fromuser. points and (stroke points length > 0)  [strokes next_ stroke]]. nil  stroke  [ points _ stroke points. [nil  rect  [points _ rect corners + points]]. rect _ Rectangle new encompass: points]]]]. stroke  [ win _ DrawingWindow new. win setBounds: rect. win strokes: strokes contents rect: rect. user schedule: win]]' classified: 'mouse, cursor and kbd'  -------------------------------------------------------------------------------- /updates/0370fixFileBrowser-vaf.st: -------------------------------------------------------------------------------- 1 | 'Changes from (10 February 2025 11:45:19 pm )' CodePane understands: 'kbd | key [key _ user kbck. pared  nil  [user kbd]. key = 130 or (pared hasPrompt and key = 13)  [user kbd. user shiftKey  [pared extendPrompt] self doit] key = 138  [user kbd. self compile] key = 151  "cut needs to do a copy first" [pared copyselection. pared typing] key = 165  [user kbd. self cancel] key = 204  [user kbd. pared search] pared typing]' classified: 'as yet unclassified'  CodePane understands: 'keyset [pared  nil and pared keyset]' classified: 'as yet unclassified'  CodePane understands: 'redbug [pared  nil and pared selecting]' classified: 'as yet unclassified'  CodePane understands: 'showing: str [str  nil  [pared _ scrollBar _ nil. "suppresses clearing of frame" frame clear: white] pared _ TextImage new para: str asParagraph frame: nil. pared formerly: false. pared fixframe: frame. self windowenter. scrollBar _ ([scrollBar  nil  [ScrollBar new] scrollBar]) on: frame from: pared]' classified: 'as yet unclassified'  FileNamePane understands: 'deselected [valuePane showing: nil. preview _ nil]'  -------------------------------------------------------------------------------- /updates/0371fixDraw-vaf.st: -------------------------------------------------------------------------------- 1 | 'Changes from (12 February 2025 1:15:47 pm )' UserView understands: 'draw | strokes stroke win rect points [strokes _ Stream new of: (Vector new: 4). stroke _ false. rect _ false. [RecogCursor showwhile [ while user ctrlKey do [ user anybug  [ stroke _ D1Stroke fromuser. stroke and stroke points length > 0  [strokes next_ stroke]]. stroke  [ points _ stroke points. [rect  [points _ rect corners + points]]. rect _ Rectangle new encompass: points]]]]. stroke and: rect  [ win _ DrawingWindow new. win setBounds: rect. win strokes: strokes contents rect: rect. user schedule: win]]' classified: 'mouse, cursor and kbd'  -------------------------------------------------------------------------------- /updates/0372nicerMNU-vaf.st: -------------------------------------------------------------------------------- 1 | 'Changes from (12 February 2025 6:43:22 pm )' UserView understands: 'notifyNT: msg | notifier frame [NotifyFlag  [notifier _ NotifyWindowNT new. frame _ thisContext current caller caller. "skip notifyNT: and notify:" [msg = ''user interrupt''  [frame _ frame caller]]. "skip error:" [''Message not understood: *'' match: msg  [frame _ frame caller caller]]. "skip error & messageNotUnderstood:" notifier title: msg processFrame: frame. NormalCursor topage1. self schedule: notifier; run: true] self cr; show: ''ctl-d to restart''. self ev. thisContext restart]' classified: 'handy system access'  -------------------------------------------------------------------------------- /updates/0373nicerFileBrowser-vaf.st: -------------------------------------------------------------------------------- 1 | 'Changes from (12 February 2025 7:23:24 pm )' FileNamePane understands: 'update ["awful hack to get at our window" self update: user topWindow. "Where there''s a will there''s a way" ]'  FileNamePane understands: 'update: win | fileStrings ["awful hack to get at the dictionary being inspected" fileStrings _ user fileStrings: directory matching: filter. win inspectee init: 4; insertall: fileStrings. self of: fileStrings sort. win title_ ''Files matching '' + directory + filter. win showtitle ]'  UserView understands: 'browseFiles | dict window dir filter pane "user browseFiles" [dict _ Dictionary new. dir _ [user shiftKey  [assetURL] '''']. filter _ ''*''. pane _ FileNamePane new directory: dir filter: filter. window _ InspectWindow new of: dict varPane: pane. pane update: window. user schedule: window]'  '*//lively-web.org/*' match: assetURL  [assetURL _ 'https://smalltalkzoo.thechm.org/users/codefrau/St78/assets/'].  -------------------------------------------------------------------------------- /updates/Helvetica11.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Helvetica11.strike -------------------------------------------------------------------------------- /updates/Helvetica13.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Helvetica13.strike -------------------------------------------------------------------------------- /updates/Helvetica14.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Helvetica14.strike -------------------------------------------------------------------------------- /updates/Helvetica18.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Helvetica18.strike -------------------------------------------------------------------------------- /updates/Helvetica25.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Helvetica25.strike -------------------------------------------------------------------------------- /updates/Helvetica36.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Helvetica36.strike -------------------------------------------------------------------------------- /updates/Helvetica48.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Helvetica48.strike -------------------------------------------------------------------------------- /updates/Logo24.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Logo24.strike -------------------------------------------------------------------------------- /updates/NewYork10B.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/NewYork10B.strike -------------------------------------------------------------------------------- /updates/NewYork12B.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/NewYork12B.strike -------------------------------------------------------------------------------- /updates/Palatino09.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino09.strike -------------------------------------------------------------------------------- /updates/Palatino12.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino12.strike -------------------------------------------------------------------------------- /updates/Palatino12B.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino12B.strike -------------------------------------------------------------------------------- /updates/Palatino14.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino14.strike -------------------------------------------------------------------------------- /updates/Palatino14I.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino14I.strike -------------------------------------------------------------------------------- /updates/Palatino16.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino16.strike -------------------------------------------------------------------------------- /updates/Palatino16I.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino16I.strike -------------------------------------------------------------------------------- /updates/Palatino25.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino25.strike -------------------------------------------------------------------------------- /updates/Palatino25B.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/Palatino25B.strike -------------------------------------------------------------------------------- /updates/ST72Font10.strike: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/ST72Font10.strike -------------------------------------------------------------------------------- /updates/actionpic.pic: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/actionpic.pic -------------------------------------------------------------------------------- /updates/altoPrompt.form: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/altoPrompt.form -------------------------------------------------------------------------------- /updates/defaultpic.pic: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/defaultpic.pic -------------------------------------------------------------------------------- /updates/ear.form: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/ear.form -------------------------------------------------------------------------------- /updates/makeBaseImage-bf.st: -------------------------------------------------------------------------------- 1 | "Minimal support to get updates. 2 | 3 | Paste this file into a workspace of the original Notetaker image and execute it. 4 | Save as a base image. Then load updates via the desktop menu item. 5 | 6 | NOTE: unlike other .st files, this one has LF and Unicode characters in it. 7 | The VM paste code will convert them to CR and the Notetaker character set, 8 | so you can paste it into the workspace. 9 | 10 | For experimenting locally, you can change the update URL to e.g. 'http:updates/'. 11 | " 12 | 13 | Smalltalk declare: ↪updateURL as: 'https://smalltalkzoo.thechm.org/users/codefrau/St78/updates/'. 14 | 15 | UserView understands: 'fileString: fileName "local file name or http URL" 16 | [⇑nil] primitive: 66' classified: 'As yet unclassified'. 17 | 18 | UserView understands: 'filin: fileName | file chunk 19 | [file ← self fileString: fileName. 20 | file ≡ nil ⇒ 21 | [user cr. 22 | user show: fileName + '' is absent.''. 23 | ⇑nil] 24 | user cr. 25 | user show: ''Reading '' + fileName + ''...''. 26 | file ← file asStream. 27 | FilinSource ← self. 28 | until⦂ file end do⦂ 29 | [chunk ← file upto: 30. 30 | user print: nil ⓢ chunk. 31 | user space. 32 | file peek = 26 ⇒ 33 | [file skipTo: ''\'' ◦ 1. 34 | file skipTo: ''g'' ◦ 1]]. 35 | self show: ''''. 36 | self cr. 37 | FilinSource ← nil]' classified: 'As yet unclassified'. 38 | 39 | user filin: (Smalltalk ◦ ↪updateURL) + '0001InitUpdates-bf.st'. 40 | user filin: (Smalltalk ◦ ↪updateURL) + '0002fileInOut-di.st'. 41 | user filin: (Smalltalk ◦ ↪updateURL) + '0003updates-bf.st'. 42 | user filin: (Smalltalk ◦ ↪updateURL) + '0004imageSave-bf.st'. 43 | background ← ltgray. 44 | user clear; show: 'Smalltalk-78 / Notetaker revival: Installed basic support methods. You can load updates now.'. 45 | -------------------------------------------------------------------------------- /updates/toolpic.pic: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codefrau/Smalltalk78/bdd40c78af3e447824e9f377a24533a6f91d0e92/updates/toolpic.pic --------------------------------------------------------------------------------