├── .gitignore ├── CHANGELOG.md ├── LICENSE.txt ├── README.md ├── boxer-sunrise-core-test.asd ├── boxer-sunrise-core.asd ├── boxer-sunrise-test.asd ├── boxer-sunrise.asd ├── data └── boxersunrise.app │ └── Contents │ ├── Info.plist │ ├── PkgInfo │ └── Resources │ ├── Fonts │ ├── LICENSE-Liberation-Fonts │ ├── LiberationMono-Bold.ttf │ ├── LiberationMono-BoldItalic.ttf │ ├── LiberationMono-Italic.ttf │ ├── LiberationMono-Regular.ttf │ ├── LiberationSans-Bold.ttf │ ├── LiberationSans-BoldItalic.ttf │ ├── LiberationSans-Italic.ttf │ ├── LiberationSans-Regular.ttf │ ├── LiberationSerif-Bold.ttf │ ├── LiberationSerif-BoldItalic.ttf │ ├── LiberationSerif-Italic.ttf │ ├── LiberationSerif-Regular.ttf │ └── info.txt │ ├── boxer-app.icns │ ├── boxer-file.icns │ ├── boxer-sunrise.icns │ ├── boxer.entitlements │ └── images │ ├── boxer16x16icons.png │ ├── scratch-icons.bmp │ └── scratch-icons.png ├── deliver.sh ├── docs ├── README.md ├── boxer-editor-commands.md ├── boxer-file-format.md ├── boxer-key-names.md ├── boxer-primitives.md ├── code-signing-and-notarizing.md ├── conventions.md ├── data-structures.md ├── dev-debugging-inspecting.md ├── development-notes.md ├── glossary.md ├── images │ └── box-interface-values.png ├── legagy-font-sizes.txt ├── lwm-keyboard-key-name-alist.md ├── ogl-fonts.md └── simple-print-dump-fi.txt ├── run-core-tests.lisp ├── run-tests.lisp ├── scripts └── macos-build-notarize.sh ├── src ├── bootstrap-glfw.lisp ├── bootstrap-text-repl.lisp ├── bootstrap.lisp ├── boxer-sunrise.lisp ├── boxwin │ ├── boxapp-data.lisp │ ├── eval-command-loop.lisp │ ├── glfw │ │ ├── boxer-sunrise-glfw.asd │ │ └── boxwin-glfw.lisp │ ├── lw-capi │ │ ├── boxer-lw-opengl-canvas.lisp │ │ ├── boxer-sunrise-capi.asd │ │ ├── boxwin-opengl.lisp │ │ ├── click-handlers.lisp │ │ ├── clipboard.lisp │ │ ├── color-picker-menu.lisp │ │ ├── confirm-quit-dialogs.lisp │ │ ├── error-dialogs.lisp │ │ ├── file-dialogs.lisp │ │ ├── lw-menu.lisp │ │ ├── lw-toolbar.lisp │ │ ├── outline-tree.lisp │ │ ├── pane-callbacks.lisp │ │ ├── preferences-dialog.lisp │ │ ├── scrolling.lisp │ │ └── start-boxer.lisp │ ├── mousedoc.lisp │ ├── text-repl │ │ ├── boxer-sunrise-text-repl.asd │ │ └── boxwin-text-repl.lisp │ └── threejs │ │ ├── boxer-sunrise-threejs.asd │ │ ├── boxwin-threejs.lisp │ │ └── threejs-draw-bridge.lisp ├── chnkpr │ ├── chunker.lisp │ └── realprinter.lisp ├── compiler │ └── comp.lisp ├── coms │ ├── coms-fs.lisp │ ├── coms-oglmouse.lisp │ ├── comsa.lisp │ ├── comsb.lisp │ ├── comse.lisp │ ├── comsf.lisp │ ├── comss.lisp │ └── popup.lisp ├── definitions │ ├── 3d-math.lisp │ ├── boxdef.lisp │ ├── boxer-styles.lisp │ ├── boxlog.lisp │ ├── canvas.lisp │ ├── color.lisp │ ├── disdcl.lisp │ ├── disdef.lisp │ ├── fonts.lisp │ ├── macros.lisp │ ├── storage.lisp │ └── vrtdef.lisp ├── delivery-script.lisp ├── draw-low-empty │ └── empty-draw-bridge.lisp ├── draw-low-opengl330 │ ├── box-models-meshes.lisp │ ├── boxer-sunrise-opengl.asd │ ├── draw-low-opengl.lisp │ ├── draw-low-opengl330.lisp │ ├── freetype-fonts.lisp │ ├── graphics-canvas.lisp │ ├── line-shapes.lisp │ ├── opengl-draw-bridge.lisp │ ├── package.lisp │ ├── perspective.lisp │ ├── pixmap.lisp │ ├── shader-shapes.lisp │ ├── shaders │ │ ├── boxgl-arcs.fs │ │ ├── boxgl-arcs.vs │ │ ├── boxgl-atlas-glyph.fs │ │ ├── boxgl-atlas-glyph.vs │ │ ├── boxgl-circle.fs │ │ ├── boxgl-circle.vs │ │ ├── boxgl-dashed-lines.fs │ │ ├── boxgl-dashed-lines.vs │ │ ├── boxgl-ellipse.fs │ │ ├── boxgl-ellipse.vs │ │ ├── boxgl-freetype-glyph.fs │ │ ├── boxgl-freetype-glyph.vs │ │ ├── boxgl-lines.fs │ │ ├── boxgl-lines.vs │ │ ├── boxgl-pixmap.fs │ │ ├── boxgl-pixmap.vs │ │ └── boxgl-simple.vs │ └── stencils.lisp ├── draw │ ├── draw-high-common.lisp │ ├── mesh.lisp │ └── model.lisp ├── editor-high │ ├── comdef.lisp │ ├── copy-paste-buffers.lisp │ ├── makcpy.lisp │ ├── mode.lisp │ ├── mouse-tracking.lisp │ ├── mouse.lisp │ ├── oglscroll.lisp │ ├── region.lisp │ ├── search.lisp │ ├── simple-stream.lisp │ └── xfile.lisp ├── editor │ └── editor.lisp ├── evaluator │ ├── bind.lisp │ ├── ev-int.lisp │ ├── eval-eval.lisp │ ├── eval.lisp │ ├── evalmacs.lisp │ ├── fdeval.lisp │ ├── funs.lisp │ ├── process.lisp │ ├── stacks.lisp │ ├── varmacs.lisp │ └── vars.lisp ├── evalutils │ ├── errors.lisp │ ├── eval-utils.lisp │ └── transparent.lisp ├── filesystem │ ├── boxer-document-format.lisp │ ├── datasources │ │ ├── helpers.lisp │ │ ├── http-url.lisp │ │ ├── local-url.lisp │ │ ├── net-url.lisp │ │ └── url.lisp │ ├── dumper.lisp │ ├── fildfs.lisp │ ├── formats.lisp │ ├── loader.lisp │ └── surf.lisp ├── graphics │ ├── gcmeth.lisp │ ├── grmeth.lisp │ ├── sprite.lisp │ └── turtle.lisp ├── grfdefs │ ├── boxer-graphics-commands.lisp │ ├── gdispl.lisp │ ├── graphics-clear.lisp │ ├── grfdfs.lisp │ ├── grobjs.lisp │ └── wrap-line.lisp ├── impexp │ ├── boxer-sunrise-html-export.asd │ ├── full-html-export.lisp │ ├── impexp.lisp │ ├── json-export.lisp │ └── opml-export.lisp ├── keydef │ ├── alternate-names.lisp │ ├── keydef-high.lisp │ └── keys-new.lisp ├── opengl-lw-8 │ ├── capi.lisp │ ├── cocoa.lisp │ ├── compile.lisp │ ├── constants.lisp │ ├── defsys.lisp │ ├── doc.txt │ ├── examples │ │ ├── 3d-text.lisp │ │ ├── arrows.lisp │ │ ├── defsys.lisp │ │ ├── icosahedron.lisp │ │ ├── images │ │ │ ├── description.txt │ │ │ ├── down-arrow.bmp │ │ │ ├── down-disabled.bmp │ │ │ ├── up-arrow.bmp │ │ │ └── up-disabled.bmp │ │ ├── load.lisp │ │ └── texture.lisp │ ├── fns.lisp │ ├── ftgl.lisp │ ├── gtk-lib.lisp │ ├── host.lisp │ ├── load.lisp │ ├── loader.lisp │ ├── msw-lib.lisp │ ├── pkg.lisp │ ├── types.lisp │ ├── ufns.lisp │ ├── vectors.lisp │ ├── win32.lisp │ ├── xfns.lisp │ └── xm-lib.lisp ├── package.lisp ├── primitives │ ├── build.lisp │ ├── dataprims.lisp │ ├── file-prims.lisp │ ├── grprim1.lisp │ ├── grprim2.lisp │ ├── grprim3.lisp │ ├── grupfn.lisp │ ├── math-prims.lisp │ ├── misc-prims.lisp │ ├── obsolete.lisp │ ├── prims.lisp │ ├── process-prims.lisp │ ├── recursive-prims.lisp │ └── sysprims.lisp ├── redisplay │ ├── blinkers.lisp │ ├── boxer-sunrise-redisplay.asd │ ├── boxtops.lisp │ ├── dev-overlay.lisp │ ├── disply.lisp │ ├── lodisp.lisp │ ├── new-borders.lisp │ ├── repaint-2024.lisp │ ├── repaint-pass-2.lisp │ └── repaint.lisp ├── relationships │ └── infsup.lisp ├── site │ └── site.lisp ├── stepper │ ├── stepper-eval.lisp │ └── stepper.lisp ├── the-attic.lisp ├── trigger │ └── trigger.lisp ├── utilities │ └── mcl-utils.lisp └── virtcopy │ ├── edvc.lisp │ ├── vcgc.lisp │ └── virtcopy.lisp └── tests ├── alternate-names-tests.lisp ├── boxapp-data-tests.lisp ├── boxdef-tests.lisp ├── boxer-styles-tests.lisp ├── boxer-sunrise.lisp ├── chunker-tests.lisp ├── click-handlers-tests.lisp ├── comdef-tests.lisp ├── data ├── boxfiles-boxer │ └── test42.boxer ├── boxfiles-v12 │ └── hello-www.box ├── boxfiles-v5 │ └── henri-sun-v5.box ├── format-tests │ ├── hello.txt │ └── really-a-png.box ├── testing │ └── readme.md └── unique-filenames │ ├── test1 │ └── Untitled 2.box │ └── test2 │ ├── Untitled 1.box │ ├── Untitled 2.box │ └── Untitled.box ├── disdcl-tests.lisp ├── draw-high-tests.lisp ├── draw-low-opengl-tests.lisp ├── dumper-tests.lisp ├── formats-tests.lisp ├── freetype-fonts-tests.lisp ├── gdispl-tests.lisp ├── keydef-high-tests.lisp ├── loader-tests.lisp ├── stacks-tests.lisp ├── vrtdef-tests.lisp └── wrap-line-tests.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* 9 | data/boxersunrise.app/Contents/CodeResources 10 | data/boxersunrise.app/Contents/_CodeSignature/CodeResources 11 | .DS_Store 12 | .vscode 13 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 2 | 3 | Redistribution and use in source and binary forms, with or without modification, 4 | are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | 3. Neither the name of the copyright holder nor the names of its contributors 14 | may be used to endorse or promote products derived from this software without 15 | specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 20 | IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, 21 | INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 23 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 24 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 25 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 26 | POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /boxer-sunrise-core-test.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of boxer-sunrise project. 3 | Copyright (c) 2019 Steven Githens (steve@githens.org) 4 | |# 5 | 6 | (defsystem "boxer-sunrise-core-test" 7 | :defsystem-depends-on ("prove-asdf") 8 | :author "Steven Githens" 9 | :license "" 10 | :depends-on ("boxer-sunrise-core" 11 | "prove") 12 | :components ((:module "tests" 13 | :components 14 | ((:test-file "boxer-sunrise") 15 | (:test-file "boxdef-tests") 16 | ; (:test-file "stacks-tests") 17 | ; (:test-file "boxapp-data-tests") 18 | ; (:test-file "comdef-tests") 19 | ; (:test-file "click-handlers-tests") 20 | ; (:test-file "alternate-names-tests") 21 | ;; (:test-file "chunker-tests") 22 | ; (:test-file "vrtdef-tests") 23 | ; (:test-file "loader-tests") 24 | ; (:test-file "keydef-high-tests") 25 | ; (:test-file "gdispl-tests") 26 | ))) 27 | :description "Test system for boxer-sunrise-core" 28 | 29 | :perform (test-op (op c) (symbol-call :prove-asdf :run-test-system c))) 30 | -------------------------------------------------------------------------------- /boxer-sunrise-core.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of boxer-sunrise project. 3 | Copyright (c) 2019 Steven Githens (steve@githens.org) 4 | |# 5 | 6 | #| 7 | Author: Steven Githens (steve@githens.org) 8 | |# 9 | 10 | (defsystem "boxer-sunrise-core" 11 | :version "3.4.23" 12 | :author "Steven Githens" 13 | :license "" 14 | :depends-on ("uiop" 15 | #-shim-3d-math "3d-matrices") 16 | :components ((:module "src" 17 | :components 18 | ((:file "boxer-sunrise") 19 | (:file "package") 20 | (:file "definitions/boxlog" :if-feature :emscripten) 21 | #+shim-3d-math 22 | (:file "definitions/3d-math") 23 | ;; DEFINITIONS 24 | (:file "definitions/color") 25 | (:file "definitions/macros") 26 | (:file "definitions/storage") 27 | (:file "definitions/boxdef") 28 | (:file "definitions/vrtdef") 29 | (:file "definitions/fonts") 30 | (:file "definitions/disdcl") 31 | (:file "definitions/canvas")))) 32 | :description "" 33 | :long-description 34 | #.(read-file-string 35 | (subpathname *load-pathname* "README.md")) 36 | :in-order-to ((test-op (test-op "boxer-sunrise-core-test")))) 37 | -------------------------------------------------------------------------------- /boxer-sunrise-test.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of boxer-sunrise project. 3 | Copyright (c) 2019 Steven Githens (steve@githens.org) 4 | |# 5 | 6 | (defsystem "boxer-sunrise-test" 7 | :defsystem-depends-on ("prove-asdf") 8 | :author "Steven Githens" 9 | :license "" 10 | :depends-on (:boxer-sunrise 11 | :prove 12 | :md5) 13 | :components ((:module "tests" 14 | :components 15 | ((:test-file "boxer-sunrise") 16 | (:test-file "boxdef-tests") 17 | (:test-file "stacks-tests") 18 | (:test-file "boxapp-data-tests") 19 | (:test-file "comdef-tests") 20 | (:test-file "click-handlers-tests") 21 | (:test-file "alternate-names-tests") 22 | ;; (:test-file "chunker-tests") 23 | (:test-file "vrtdef-tests") 24 | ; (:test-file "loader-tests") 25 | (:test-file "keydef-high-tests") 26 | (:test-file "gdispl-tests") 27 | #+lispworks (:test-file "dumper-tests") 28 | #+lispworks (:test-file "formats-tests") 29 | ; (:test-file "eval-eval-tests") 30 | #+lispworks (:test-file "boxer-styles-tests") 31 | (:test-file "freetype-fonts-tests") 32 | (:test-file "disdcl-tests") 33 | (:test-file "draw-high-tests") 34 | (:test-file "draw-low-opengl-tests") 35 | (:test-file "wrap-line-tests") 36 | ))) 37 | :description "Test system for boxer-sunrise" 38 | 39 | :perform (test-op (op c) (symbol-call :prove-asdf :run-test-system c))) 40 | -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Info.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | CFBundleDevelopmentRegion 6 | English 7 | 8 | CFBundleDocumentTypes 9 | 10 | 11 | CFBundleTypeExtensions 12 | 13 | box 14 | box~ 15 | box# 16 | 17 | CFBundleTypeIconFile 18 | boxer-file.icns 19 | CFBundleTypeName 20 | com.pyxisystems.boxer.file 21 | CFBundleTypeOSTypes 22 | 23 | BOXR 24 | 25 | CFBundleTypeRole 26 | Editor 27 | 28 | 29 | 30 | CFBundleExecutable 31 | boxersunrise 32 | 33 | CFBundleIconFile 34 | boxer-sunrise.icns 35 | 36 | CFBundleIdentifier 37 | org.boxer.BoxerSunrise 38 | 39 | CFBundleInfoDictionaryVersion 40 | 6.0 41 | 42 | CFBundleGetInfoString 43 | 3.4 Boxer - Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 44 | 45 | NSHumanReadableCopyright 46 | 3.4 Boxer - Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 47 | 48 | CFBundleName 49 | boxersunrise 50 | 51 | CFBundlePackageType 52 | APPL 53 | 54 | CFBundleShortVersionString 55 | Boxer 3.4 56 | 57 | CFBundleSignature 58 | BOXR 59 | 60 | CFBundleVersion 61 | 3.4 62 | 63 | NSPrincipalClass 64 | NSApplication 65 | 66 | 67 | -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/PkgInfo: -------------------------------------------------------------------------------- 1 | APPL???? -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LICENSE-Liberation-Fonts: -------------------------------------------------------------------------------- 1 | Digitized data copyright (c) 2010 Google Corporation 2 | with Reserved Font Arimo, Tinos and Cousine. 3 | Copyright (c) 2012 Red Hat, Inc. 4 | with Reserved Font Name Liberation. 5 | 6 | This Font Software is licensed under the SIL Open Font License, 7 | Version 1.1. 8 | 9 | This license is copied below, and is also available with a FAQ at: 10 | http://scripts.sil.org/OFL 11 | 12 | SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 13 | 14 | PREAMBLE The goals of the Open Font License (OFL) are to stimulate 15 | worldwide development of collaborative font projects, to support the font 16 | creation efforts of academic and linguistic communities, and to provide 17 | a free and open framework in which fonts may be shared and improved in 18 | partnership with others. 19 | 20 | The OFL allows the licensed fonts to be used, studied, modified and 21 | redistributed freely as long as they are not sold by themselves. 22 | The fonts, including any derivative works, can be bundled, embedded, 23 | redistributed and/or sold with any software provided that any reserved 24 | names are not used by derivative works. The fonts and derivatives, 25 | however, cannot be released under any other type of license. The 26 | requirement for fonts to remain under this license does not apply to 27 | any document created using the fonts or their derivatives. 28 | 29 | 30 | 31 | DEFINITIONS 32 | "Font Software" refers to the set of files released by the Copyright 33 | Holder(s) under this license and clearly marked as such. 34 | This may include source files, build scripts and documentation. 35 | 36 | "Reserved Font Name" refers to any names specified as such after the 37 | copyright statement(s). 38 | 39 | "Original Version" refers to the collection of Font Software components 40 | as distributed by the Copyright Holder(s). 41 | 42 | "Modified Version" refers to any derivative made by adding to, deleting, 43 | or substituting ? in part or in whole ? 44 | any of the components of the Original Version, by changing formats or 45 | by porting the Font Software to a new environment. 46 | 47 | "Author" refers to any designer, engineer, programmer, technical writer 48 | or other person who contributed to the Font Software. 49 | 50 | 51 | PERMISSION & CONDITIONS 52 | 53 | Permission is hereby granted, free of charge, to any person obtaining a 54 | copy of the Font Software, to use, study, copy, merge, embed, modify, 55 | redistribute, and sell modified and unmodified copies of the Font 56 | Software, subject to the following conditions: 57 | 58 | 1) Neither the Font Software nor any of its individual components,in 59 | Original or Modified Versions, may be sold by itself. 60 | 61 | 2) Original or Modified Versions of the Font Software may be bundled, 62 | redistributed and/or sold with any software, provided that each copy 63 | contains the above copyright notice and this license. These can be 64 | included either as stand-alone text files, human-readable headers or 65 | in the appropriate machine-readable metadata fields within text or 66 | binary files as long as those fields can be easily viewed by the user. 67 | 68 | 3) No Modified Version of the Font Software may use the Reserved Font 69 | Name(s) unless explicit written permission is granted by the 70 | corresponding Copyright Holder. This restriction only applies to the 71 | primary font name as presented to the users. 72 | 73 | 4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font 74 | Software shall not be used to promote, endorse or advertise any 75 | Modified Version, except to acknowledge the contribution(s) of the 76 | Copyright Holder(s) and the Author(s) or with their explicit written 77 | permission. 78 | 79 | 5) The Font Software, modified or unmodified, in part or in whole, must 80 | be distributed entirely under this license, and must not be distributed 81 | under any other license. The requirement for fonts to remain under 82 | this license does not apply to any document created using the Font 83 | Software. 84 | 85 | 86 | 87 | TERMINATION 88 | This license becomes null and void if any of the above conditions are not met. 89 | 90 | 91 | 92 | DISCLAIMER 93 | THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 94 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF 95 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT 96 | OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE 97 | COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 98 | INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 99 | DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 100 | FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM OTHER 101 | DEALINGS IN THE FONT SOFTWARE. 102 | 103 | -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationMono-Bold.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationMono-Bold.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationMono-BoldItalic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationMono-BoldItalic.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationMono-Italic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationMono-Italic.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationMono-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationMono-Regular.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationSans-Bold.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationSans-Bold.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationSans-BoldItalic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationSans-BoldItalic.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationSans-Italic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationSans-Italic.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationSans-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationSans-Regular.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationSerif-Bold.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationSerif-Bold.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationSerif-BoldItalic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationSerif-BoldItalic.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationSerif-Italic.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationSerif-Italic.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/LiberationSerif-Regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/Fonts/LiberationSerif-Regular.ttf -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/Fonts/info.txt: -------------------------------------------------------------------------------- 1 | OpenGL CAPI fonts converted on 21:38:6 4/8/2014 2 | Font Families: Arial, Courier New, Times New Roman, Verdana 3 | Sizes: 8 9 10 12 14 16 20 24 28 32 40 48 56 64 4 | Converted with white defined as unweighted RGB > 2.0 5 | Liberation-ttf-Fonts version 2.1.1 6 | -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/boxer-app.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/boxer-app.icns -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/boxer-file.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/boxer-file.icns -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/boxer-sunrise.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/boxer-sunrise.icns -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/boxer.entitlements: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 9 | com.apple.security.files.user-selected.read-write 10 | 11 | com.apple.security.network.client 12 | 13 | com.apple.security.network.server 14 | 15 | com.apple.security.temporary-exception.files.home-relative-path.read-write 16 | 17 | Library/Application Support/Boxer/boxapp-data.lisp 18 | Library/Preferences/Boxer.prf 19 | 20 | com.apple.security.cs.allow-unsigned-executable-memory 21 | 22 | com.apple.security.cs.disable-library-validation 23 | 24 | 26 | 27 | 28 | com.apple.security.automation.apple-events 29 | 30 | com.apple.security.cs.allow-jit 31 | 32 | com.apple.security.device.audio-input 33 | 34 | com.apple.security.device.camera 35 | 36 | com.apple.security.personal-information.addressbook 37 | 38 | com.apple.security.personal-information.calendars 39 | 40 | com.apple.security.personal-information.location 41 | 42 | com.apple.security.personal-information.photos-library 43 | 44 | 45 | 46 | com.apple.security.cs.allow-dyld-environment-variables 47 | 48 | 50 | com.apple.security.cs.disable-executable-page-protection 51 | 52 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/images/boxer16x16icons.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/images/boxer16x16icons.png -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/images/scratch-icons.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/images/scratch-icons.bmp -------------------------------------------------------------------------------- /data/boxersunrise.app/Contents/Resources/images/scratch-icons.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/data/boxersunrise.app/Contents/Resources/images/scratch-icons.png -------------------------------------------------------------------------------- /deliver.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Because of the issue with not loading cl-freetype2 until application start, we 4 | # are copying this source part to the area in the application bundle where it can 5 | # still be available after delivery 6 | cp src/draw/freetype-fonts.lisp data/boxersunrise.app/Contents/PlugIns 7 | 8 | /Applications/LispWorks\ 7.1\ \(64-bit\)/LispWorks\ \(64-bit\).app/Contents/MacOS/lispworks-7-1-0-amd64-darwin -build src/delivery-script.lisp -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | There are [many papers][literature] about the language/environment design. 2 | 3 | For understanding the implementation, the [Boxer: The Programming Language thesis from 1989][LeighKlotz1989] remains extremely insightful, especially sections 4 onwards. 4 | 5 | [literature]: https://boxer-project.github.io/boxer-literature/Thematic%20index/ 6 | [LeighKlotz1989]: https://boxer-project.github.io/boxer-literature/theses/Boxer,%20The%20Programming%20Language%20(Klotz,%20MIT%20BSc,%201989).pdf 7 | -------------------------------------------------------------------------------- /docs/boxer-file-format.md: -------------------------------------------------------------------------------- 1 | # Boxer File Format 2 | 3 | This documents the Boxer file format, used for saving Boxer microworlds with the extension `.box`. 4 | 5 | ## Overview 6 | 7 | Currently Boxer saves it's data using the file extension `.box` in a packed binary format that evokes the nostalgia of 8 | older binary formats from MS Office such `.doc`, `.xls`, etc. All assets are saved in this single binary streamed 9 | document. Work is underway to save using separated assets using a zipped format similar to the way ODF, docx, and pages 10 | files are stored. 11 | 12 | ### Binary Binary Format 13 | 14 | The Boxer binary format is a binary format, consisting of units packed using 16-bit words. A number of constants 15 | specify operations, and the data that follows conforms to that operation. Sometimes this is just regular data, and 16 | sometimes it more closely follows the layout of a lisp data structure or list to make it easier to reconstruct. The 17 | first operation always designates the version of the box format. 18 | 19 | Most the constants and procedures for reading and writing this format can be found in `fildfs.lisp`, `dumper.lisp`, and 20 | `loader.lisp`. All of these are in the `filesystem` module. 21 | 22 | ## Versions 23 | 24 | Historically, the only "old" versions of box files we have are files saved using version 5, which was a stable release 25 | used in schools running on Sun OS workstations. From 2014 thru Boxer 3.4.9 version 12 was in use. Boxer 3.4.10 made 26 | 2 small changes in the format to bring the version to 13. 27 | 28 | TODO: Check and see what version the old windows build was using. Probably 12. 29 | 30 | ### Version 1 thru 4 31 | 32 | As of now little is known about these early versions and we don't have any box files saved in these versions. 33 | 34 | ### Version 5 35 | 36 | We have a collection of old files using version 5. These come from a Sun OS version of Boxer that was used in public 37 | schools and other educational institutions. 38 | 39 | ### Versions 6 thru 11 40 | 41 | As of now little is known about these early versions and we don't have any box files saved in these versions. 42 | 43 | ### Version 12 44 | 45 | Version 12 was used for a long period, from the last pre-sunrise build in 2014 thru Boxer v3.4.9 2022-05-05. 46 | 47 | ### Version 13 48 | 49 | Version 13 makes some minor changes from 12, and was introduced in Boxer v3.4.10 2022-07-11. 50 | 51 | Changes: 52 | - sunrise-36 Added alpha layer to pixmaps. Previously was only saving RGB values. 53 | 54 | https://github.com/boxer-project/boxer-sunrise/blob/38a2cc7f4d224318d8aaaeef3ea55ddb4cd1fc6a/src/filesystem/dumper.lisp#L1139 55 | 56 | https://github.com/boxer-project/boxer-sunrise/blob/38a2cc7f4d224318d8aaaeef3ea55ddb4cd1fc6a/src/filesystem/loader.lisp#L1228 57 | 58 | - sunrise-52 Changed name rows to dump as string. Allows higher unicode characters in box names. 59 | 60 | https://github.com/boxer-project/boxer-sunrise/commit/d843d7374557bbd1619747de82956bb707e66edd 61 | 62 | ### Version 14 63 | 64 | Version 14 is a marker version to note that a new graphics list command has been added for 65 | graphics-sheets-graphics-list, such that any Boxer documents saved with this graphics command will not 66 | open in earlier versions of Boxer. 67 | 68 | - Added in Boxer version 3.4.14 69 | - New graphics command is 37, allowing rotation/translation/scaling of turtle drawing operations by supplying 70 | a 4x4 transformation matrix. 71 | ``` 72 | 37 BOXER-TRANSFORM-MATRIX (MATRIX) 4x4 matrix packed in 1x16 single-float vector 73 | In order to fix/support stamp-self with the same rotations/scaling/etc with bitmaps and all 74 | primitives we need to move beyond the simple hand transforms. This graphics display list 75 | command allows putting an arbitrary 4x4 transformation matrix in the graphics list to 76 | affect upcoming commands. 77 | ``` 78 | -------------------------------------------------------------------------------- /docs/conventions.md: -------------------------------------------------------------------------------- 1 | # Coding and Documentation Conventions 2 | 3 | ## Git Commit Message Prefixes 4 | 5 | Each commit message should ideally begin with one of the following prefixes: 6 | 7 | - `boxer-sunrise-{num}` For a commit addressing a ticket number in the github issues for the repo, use this with the 8 | number of the ticket. ex: `boxer-sunrise-42 Implemented meaning of the universe` 9 | - `boxer-bugs-{num}` As part of our efforts of dogfooding Boxer, some bugs and issues are logged in a Boxer based 10 | database. These should be indexed by their number in that database. 11 | ie. `boxer-bugs-35 Fixing key/mouse help menu` 12 | - `format` For commits that are re-indenting code or comments with no impact on behavior can simply be prefixed with 13 | `format` 14 | - `crash-fix` Commits that fix a minor issue that caused a system crash, but was not part of another ticket, such as 15 | a bad argument type, division by zero, etc, can be prefixed with `crash-fix` 16 | - `re-org` Commits that are simple moving around files or directory structure can begin with `re-org` 17 | - `the-attic` Commits which are retiring old unused code to the attic can be prefixed with `the-attic`. This involves 18 | code that was commented out, or not included via `#+` reader macros for some platform that no longer exists. If the 19 | code is interesting, it's usually pasted in the `the-attic.lisp` so it can be searched easily in the future. 20 | - `doco` - Any commits adding or updating documentation... such as this file. 21 | -------------------------------------------------------------------------------- /docs/dev-debugging-inspecting.md: -------------------------------------------------------------------------------- 1 | # Development Debugging and Inspecting 2 | 3 | ## Inspecting the box data structures 4 | 5 | When running boxer, the following global variables allow access to viewing the current running state, and these can 6 | be accessed from a REPL. 7 | 8 | - boxer::*initial-box* This is the top level root box for the entire world. 9 | - boxer::*outermost-screen-box* This is whichever box is current full screened in the world. 10 | - boxer::*point* This contains a structure which includes the current row and screen-box of the cursor/point which can 11 | be inspected. 12 | 13 | ## Box under mouse 14 | 15 | ```lisp 16 | ;; The following will return the location and box object currently under the mouse. This can be especially 17 | ;; useful for getting a sprite or graphics box that is unavailable to having the cursor on it. 18 | > (bw::mouse-place) 19 | :SPRITE 20 | # 21 | ``` 22 | 23 | ## Box Flags 24 | 25 | The current box flags under the mouse can be viewed with `(boxer:show-box-flags box)`. 26 | 27 | ```lisp 28 | (in-package :boxer) 29 | 30 | (show-box-flags (screen-obj-actual-obj (cadr (multiple-value-list (bw::mouse-place))))) 31 | ``` 32 | 33 | ## Restarting the boxer canvas after investigating an error 34 | 35 | After debugging/inspecting an issue stopped execution while running Boxer in Lispworks, the world canvas can 36 | be restarted at the REPL with: 37 | 38 | ``` 39 | (bw::boxer-process-top-level-fn bw::*boxer-pane*) 40 | ``` 41 | 42 | ## Using `trace` 43 | 44 | (trace (boxer::reset-region :break (equal boxer::*debug-reset-region* t))) 45 | 46 | ## Dumping the contents of a Box file 47 | 48 | Dumping the version and opcodes of a `.box` file can be done at the REPL with: 49 | 50 | ``` 51 | 52 | ``` 53 | 54 | ## Debugging test cases 55 | 56 | Currently we are using `prove` and you can set it to hit the debugger on errors with: 57 | 58 | ```lisp 59 | (setf prove:*debug-on-error* t) 60 | ``` 61 | 62 | ## Changing the keybindings at runtime 63 | 64 | The `make-input-devices` defun from `keydef-high.lisp` is what sets up all the keybindings and 65 | can optionally rebind all the keys (if being run again after the initial boxer load and setup). 66 | This is also what is called when we have the machine platform option in the user preferences 67 | accessible from the top menu. 68 | 69 | ```lisp 70 | ;; Using in initial setup: 71 | (make-input-devices *initial-platform* nil) 72 | 73 | ;; Rebinding later in the application: 74 | (make-input-devices canonicalized-name) ; such as :LWM 75 | ``` 76 | -------------------------------------------------------------------------------- /docs/development-notes.md: -------------------------------------------------------------------------------- 1 | # Development Notes 2 | 3 | ## Running cl-opengl examples 4 | 5 | In portacle the following can be run. You do need to have freeglut or some 6 | other package that includes libglut3 installed. 7 | 8 | On Ubuntu this can be installed with `apt-get install freeglut3`. 9 | 10 | ```lisp 11 | (ql:quickload 'cl-opengl) 12 | (asdf:load-system 'cl-glut-examples) 13 | (cl-glut-examples:run-examples) 14 | ``` 15 | 16 | ## Running the lispworks opengl examples 17 | 18 | ```lisp 19 | (load (example-file "opengl/examples/load")) 20 | (setf v (capi:display (make-instance 'icosahedron-viewer))) 21 | ``` 22 | -------------------------------------------------------------------------------- /docs/images/box-interface-values.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/docs/images/box-interface-values.png -------------------------------------------------------------------------------- /docs/legagy-font-sizes.txt: -------------------------------------------------------------------------------- 1 | 16 Arial 9 2 | 32 Arial 10 3 | 48 Arial 12 4 | 64 Arial 14 5 | 80 Arial 16 6 | 96 Arial 20 7 | 112 Arial 24 8 | 17 Arial 9 Bold 9 | 33 Arial 10 Bold 10 | 49 Arial 12 Bold 11 | 65 Arial 14 Bold 12 | 81 Arial 16 Bold 13 | 97 Arial 20 Bold 14 | 113 Arial 24 Bold 15 | 18 Arial 9 Italic 16 | 34 Arial 10 Italic 17 | 50 Arial 12 Italic 18 | 66 Arial 14 Italic 19 | 82 Arial 16 Italic 20 | 98 Arial 20 Italic 21 | 114 Arial 24 Italic 22 | 19 Arial 9 Bold Italic 23 | 35 Arial 10 Bold Italic 24 | 51 Arial 12 Bold Italic 25 | 67 Arial 14 Bold Italic 26 | 83 Arial 16 Bold Italic 27 | 99 Arial 20 Bold Italic 28 | 115 Arial 24 Bold Italic 29 | 65552 Courier New 9 30 | 65568 Courier New 10 31 | 65584 Courier New 12 32 | 65600 Courier New 14 33 | 65616 Courier New 16 34 | 65632 Courier New 20 35 | 65648 Courier New 24 36 | 37 | 65553 Courier New 9 Bold 38 | 65569 Courier New 10 Bold 39 | 65585 Courier New 12 Bold 40 | 65601 Courier New 14 Bold 41 | 65617 Courier New 16 Bold 42 | 65633 Courier New 20 Bold 43 | 65649 Courier New 24 Bold 44 | 45 | 65554 Courier New 9 Italic 46 | 65570 Courier New 10 Italic 47 | 65586 Courier New 12 Italic 48 | 65602 Courier New 14 Italic 49 | 65618 Courier New 16 Italic 50 | 65634 Courier New 20 Italic 51 | 65650 Courier New 24 Italic 52 | 53 | 65555 Courier New 9 Bold Italic 54 | 65571 Courier New 10 Bold Italic 55 | 65587 Courier New 12 Bold Italic 56 | 65603 Courier New 14 Bold Italic 57 | 65619 Courier New 16 Bold Italic 58 | 65635 Courier New 20 Bold Italic 59 | 65651 Courier New 24 Bold Italic 60 | 61 | 131088 Times New Roman 9 62 | 131104 Times New Roman 10 63 | 131120 Times New Roman 12 64 | 131136 Times New Roman 14 65 | 131152 Times New Roman 16 66 | 131168 Times New Roman 20 67 | 131184 Times New Roman 24 68 | 69 | 131089 Times New Roman 9 Bold 70 | 131105 Times New Roman 10 Bold 71 | 131121 Times New Roman 12 Bold 72 | 131137 Times New Roman 14 Bold 73 | 131153 Times New Roman 16 Bold 74 | 131169 Times New Roman 20 Bold 75 | 131185 Times New Roman 24 Bold 76 | 77 | 131090 Times New Roman 9 Italic 78 | 131106 Times New Roman 10 Italic 79 | 131122 Times New Roman 12 Italic 80 | 131138 Times New Roman 14 Italic 81 | 131154 Times New Roman 16 Italic 82 | 131170 Times New Roman 20 Italic 83 | 131186 Times New Roman 24 Italic 84 | 85 | 131091 Times New Roman 9 Bold Italic 86 | 131107 Times New Roman 10 Bold Italic 87 | 131123 Times New Roman 12 Bold Italic 88 | 131139 Times New Roman 14 Bold Italic 89 | 131155 Times New Roman 16 Bold Italic 90 | 131171 Times New Roman 20 Bold Italic 91 | 131187 Times New Roman 24 Bold Italic 92 | 93 | 196624 Verdana 9 94 | 169640 Verdana 10 95 | 196656 Verdana 12 96 | 196672 Verdana 14 97 | 196688 Verdana 16 98 | 196704 Verdana 20 99 | 196720 Verdana 24 100 | 101 | 196625 Verdana 9 Bold 102 | 196641 Verdana 10 Bold 103 | 196657 Verdana 12 Bold 104 | 196673 Verdana 14 Bold 105 | 196689 Verdana 16 Bold 106 | 196705 Verdana 20 Bold 107 | 196721 Verdana 24 Bold 108 | 109 | 196626 Verdana 9 Italic 110 | 196642 Verdana 10 Italic 111 | 196658 Verdana 12 Italic 112 | 196674 Verdana 14 Italic 113 | 196690 Verdana 16 Italic 114 | 196706 Verdana 20 Italic 115 | 196722 Verdana 24 Italic 116 | 117 | 196627 Verdana 9 Bold Italic 118 | 196643 Verdana 10 Bold Italic 119 | 196659 Verdana 12 Bold Italic 120 | 196675 Verdana 14 Bold Italic 121 | 196691 Verdana 16 Bold Italic 122 | 196707 Verdana 20 Bold Italic 123 | 196723 Verdana 24 Bold Italic 124 | 125 | Legacy fonts 1 thru 7 126 | 127 | 1 33 128 | 2 34 129 | 3 35 130 | 4 0 ???? 131 | 5 1 132 | 6 2 133 | 7 3 134 | 8 0 135 | 9 1 136 | 10 2 137 | 11 3 138 | 12 0 139 | -------------------------------------------------------------------------------- /docs/lwm-keyboard-key-name-alist.md: -------------------------------------------------------------------------------- 1 | 2021-07-07 2 | 3 | (pprint boxer::*LWM-keyboard-key-name-alist*) 4 | 5 | ((BOXER-USER::MODE-SWITCH-KEY 328) 6 | (BOXER-USER::HELP-KEY 327) 7 | (BOXER-USER::FIND-KEY 326) 8 | (BOXER-USER::REDO-KEY 325) 9 | (BOXER-USER::UNDO-KEY 324) 10 | (BOXER-USER::EXECUTE-KEY 323) 11 | (BOXER-USER::SELECT-KEY 322) 12 | (BOXER-USER::NEXT-KEY 321) 13 | (BOXER-USER::PREV-KEY 320) 14 | (BOXER-USER::DELETE-CHAR-KEY 319) 15 | (BOXER-USER::INSERT-CHAR-KEY 318) 16 | (BOXER-USER::DELETE-LINE-KEY 317) 17 | (BOXER-USER::INSERT-LINE-KEY 316) 18 | (BOXER-USER::CLEAR-DISPLAY-KEY 315) 19 | (BOXER-USER::PRINT-KEY 314) 20 | (BOXER-USER::SYSTEM-KEY 313) 21 | (BOXER-USER::USER-KEY 312) 22 | (BOXER-USER::MENU-KEY 311) 23 | (BOXER-USER::STOP-KEY 310) 24 | (BOXER-USER::RESET-KEY 309) 25 | (BOXER-USER::BREAK-KEY 308) 26 | (BOXER-USER::SYS-REQ-KEY 307) 27 | (BOXER-USER::PAUSE-KEY 306) 28 | (BOXER-USER::SCROLL-LOCK-KEY 305) 29 | (BOXER-USER::PRINT-SCREEN-KEY 304) 30 | (BOXER-USER::BEGIN-KEY 303) 31 | (BOXER-USER::DELETE-KEY 302) 32 | (BOXER-USER::INSERT-KEY 301) 33 | (BOXER-USER::CLEAR-LINE-KEY 300) 34 | (BOXER-USER::PAGE-DOWN-KEY 299) 35 | (BOXER-USER::PAGE-UP-KEY 298) 36 | (BOXER-USER::F35-KEY 297) 37 | (BOXER-USER::F34-KEY 296) 38 | (BOXER-USER::F33-KEY 295) 39 | (BOXER-USER::F32-KEY 294) 40 | (BOXER-USER::F31-KEY 293) 41 | (BOXER-USER::F30-KEY 292) 42 | (BOXER-USER::F29-KEY 291) 43 | (BOXER-USER::F28-KEY 290) 44 | (BOXER-USER::F27-KEY 289) 45 | (BOXER-USER::F26-KEY 288) 46 | (BOXER-USER::F25-KEY 287) 47 | (BOXER-USER::F24-KEY 286) 48 | (BOXER-USER::F23-KEY 285) 49 | (BOXER-USER::F22-KEY 284) 50 | (BOXER-USER::F21-KEY 283) 51 | (BOXER-USER::F20-KEY 282) 52 | (BOXER-USER::F19-KEY 281) 53 | (BOXER-USER::F18-KEY 280) 54 | (BOXER-USER::F17-KEY 279) 55 | (BOXER-USER::F16-KEY 278) 56 | (BOXER-USER::F15-KEY 277) 57 | (BOXER-USER::F14-KEY 276) 58 | (BOXER-USER::F13-KEY 275) 59 | (BOXER-USER::F12-KEY 274) 60 | (BOXER-USER::F11-KEY 273) 61 | (BOXER-USER::F10-KEY 272) 62 | (BOXER-USER::F9-KEY 271) 63 | (BOXER-USER::F8-KEY 270) 64 | (BOXER-USER::F7-KEY 269) 65 | (BOXER-USER::F6-KEY 268) 66 | (BOXER-USER::F5-KEY 267) 67 | (BOXER-USER::F4-KEY 266) 68 | (BOXER-USER::F3-KEY 265) 69 | (BOXER-USER::F2-KEY 264) 70 | (BOXER-USER::F1-KEY 263) 71 | (BOXER-USER::END-KEY 262) 72 | (BOXER-USER::HOME-KEY 261) 73 | (BOXER-USER::RIGHT-ARROW-KEY 260) 74 | (BOXER-USER::LEFT-ARROW-KEY 259) 75 | (BOXER-USER::DOWN-ARROW-KEY 258) 76 | (BOXER-USER::UP-ARROW-KEY 257)) 77 | -------------------------------------------------------------------------------- /run-core-tests.lisp: -------------------------------------------------------------------------------- 1 | (require "asdf") 2 | 3 | ;; Sometimes lispworks doesn't seem to load the initialization file when running from 4 | ;; the command line, in which case this could be uncommented. 5 | ;; (load "~/quicklisp/setup.lisp") 6 | 7 | (ql:quickload "prove-asdf") 8 | (ql:quickload "cl-ppcre") 9 | (ql:quickload "prove") 10 | 11 | (ql:quickload :cl-fad) 12 | (ql:quickload :log4cl) 13 | (ql:quickload :cffi) 14 | 15 | (defvar *boxer-project-dir* (make-pathname :directory (pathname-directory *load-truename*))) 16 | 17 | (pushnew 18 | (cl-fad:merge-pathnames-as-directory *boxer-project-dir* "data/boxersunrise.app/Contents/Frameworks/") 19 | cffi:*foreign-library-directories* :test #'equal) 20 | 21 | (setf asdf:*central-registry* 22 | (list* '*default-pathname-defaults* 23 | *boxer-project-dir* 24 | asdf:*central-registry*)) 25 | 26 | ;; This turns off the terminal color sequences and simplifies the characters in the 27 | ;; output so they display well in the lispworks listener. 28 | (setf prove:*enable-colors* nil) 29 | (setf prove::*default-reporter* :tap) 30 | 31 | #+lispworks (load (example-file "opengl/examples/load")) 32 | 33 | (asdf:test-system :boxer-sunrise-core :reporter :list) 34 | -------------------------------------------------------------------------------- /run-tests.lisp: -------------------------------------------------------------------------------- 1 | (require "asdf") 2 | 3 | ;; Sometimes lispworks doesn't seem to load the initialization file when running from 4 | ;; the command line, in which case this could be uncommented. 5 | ;; (load "~/quicklisp/setup.lisp") 6 | 7 | (ql:quickload "prove-asdf") 8 | (ql:quickload "cl-ppcre") 9 | (ql:quickload "prove") 10 | 11 | (ql:quickload :cl-fad) 12 | (ql:quickload :log4cl) 13 | (ql:quickload :cffi) 14 | 15 | (defvar *boxer-project-dir* (make-pathname :directory (pathname-directory *load-truename*))) 16 | 17 | (pushnew 18 | (cl-fad:merge-pathnames-as-directory *boxer-project-dir* "data/boxersunrise.app/Contents/Frameworks/") 19 | cffi:*foreign-library-directories* :test #'equal) 20 | 21 | (setf asdf:*central-registry* 22 | (list* '*default-pathname-defaults* 23 | *boxer-project-dir* 24 | asdf:*central-registry*)) 25 | 26 | (ql:quickload :cl-freetype2) 27 | 28 | ;; This turns off the terminal color sequences and simplifies the characters in the 29 | ;; output so they display well in the lispworks listener. 30 | (setf prove:*enable-colors* nil) 31 | (setf prove::*default-reporter* :tap) 32 | 33 | #+(and lispworks x64) (load (cl-fad:merge-pathnames-as-file *boxer-project-dir* "src/opengl-lw-8/examples/load.lisp")) 34 | 35 | (asdf:test-system :boxer-sunrise :reporter :list) 36 | -------------------------------------------------------------------------------- /scripts/macos-build-notarize.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # You'll need to pass in a username and password, either as command line variables or via 3 | # the environment. This should be an app-specific password generated at https://appleid.apple.com 4 | 5 | echo "Boxer Sunrise macOS Build and Notarize\n" 6 | 7 | # Update the timestamp on the app 8 | touch data/boxersunrise.app 9 | 10 | # Because of the issue with not loading cl-freetype2 until application start, we 11 | # are copying this source part to the area in the application bundle where it can 12 | # still be available after delivery 13 | mkdir -p data/boxersunrise.app/Contents/MacOS 14 | mkdir -p data/boxersunrise.app/Contents/PlugIns/shaders 15 | cp src/draw-low-opengl330/shaders/* data/boxersunrise.app/Contents/PlugIns/shaders 16 | cp src/draw-low-opengl330/freetype-fonts.lisp data/boxersunrise.app/Contents/PlugIns 17 | 18 | 19 | read -p "Lispworks Build and Delivery [enter]" 20 | 21 | # /Applications/LispWorks\ 7.1\ \(64-bit\)/LispWorks\ \(64-bit\).app/Contents/MacOS/lispworks-7-1-0-amd64-darwin -build src/delivery-script.lisp 22 | /Applications/LispWorks\ 8.0\ \(64-bit\)/LispWorks\ \(64-bit\).app/Contents/MacOS/lispworks-8-0-0-macos64-universal -build src/delivery-script.lisp 23 | 24 | read -p "Code sign with entitlements/hardened runtime [enter]" 25 | 26 | codesign --force --verbose --entitlements ./data/boxersunrise.app/Contents/Resources/boxer.entitlements --option runtime --deep -s "Developer ID Application" ./data/boxersunrise.app 27 | 28 | read -p "Zip app to send for notarization [enter]" 29 | 30 | cd data 31 | /usr/bin/ditto -c -k --keepParent ./boxersunrise.app ./boxersunrise.zip 32 | cd .. 33 | 34 | read -p "Send for notarization with notarytool [enter]" 35 | 36 | # xcrun altool --notarize-app --password ${password} --username ${username} --file ./data/boxersunrise.zip --primary-bundle-id "boxer.notorize" 37 | # Swithing to notarytool for 2024 38 | xcrun notarytool submit --password ${password} --apple-id ${username} --team-id ${team} --wait ./data/boxersunrise.zip 39 | 40 | read -p "Remove the temporary zip file [enter]" 41 | 42 | rm ./data/boxersunrise.zip 43 | 44 | read -p "Do the dishes while you wait for the verification email from Apple... [enter]" 45 | 46 | read -p "Staple the ticket to the binary [enter]" 47 | 48 | xcrun stapler staple --file ./data/boxersunrise.app 49 | 50 | read -p "Zip again to create the final package [enter]" 51 | 52 | cd data 53 | /usr/bin/ditto -c -k --keepParent ./boxersunrise.app ./boxersunrise.zip 54 | cd .. 55 | -------------------------------------------------------------------------------- /src/bootstrap-glfw.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | ;;;; Work In Progress! GLFW Engine Bootstrap 18 | ;;;; 19 | (ql:quickload :cl-fad) 20 | (defvar *project-dir* (make-pathname :directory (butlast (pathname-directory *load-truename*)))) 21 | 22 | (pushnew *project-dir* ql:*local-project-directories* ) 23 | (ql:register-local-projects) 24 | 25 | #+ecl 26 | (defmacro without-fpe-traps (&body body) 27 | `(let ((bits (si:trap-fpe 'cl:last t))) 28 | (unwind-protect 29 | (progn 30 | (si:trap-fpe t nil) 31 | ,@body) 32 | (si:trap-fpe bits t)))) 33 | 34 | (setf *features* (cons :glfw-engine *features*)) 35 | (ql:quickload :boxer-sunrise-glfw) 36 | 37 | #+ecl 38 | (without-fpe-traps 39 | (bw::start-glfw-boxer *project-dir*)) 40 | 41 | #-ecl 42 | (bw::start-glfw-boxer *project-dir*) 43 | 44 | -------------------------------------------------------------------------------- /src/bootstrap-text-repl.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | ;;;; Work In Progress! GLFW Engine Bootstrap 18 | ;;;; 19 | (ql:quickload :cl-fad) 20 | (defvar *project-dir* (make-pathname :directory (butlast (pathname-directory *load-truename*)))) 21 | 22 | (pushnew *project-dir* ql:*local-project-directories* ) 23 | (ql:register-local-projects) 24 | 25 | 26 | (setf *features* (cons :text-repl-engine *features*)) 27 | (ql:quickload :boxer-sunrise-text-repl) 28 | 29 | (bw::start-text-repl-boxer *project-dir*) 30 | 31 | -------------------------------------------------------------------------------- /src/bootstrap.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Boxer 3 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | 5 | Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | 8 | Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | 10 | https://opensource.org/licenses/BSD-3-Clause 11 | 12 | 13 | +-Data--+ 14 | This file is part of the | BOXER | system 15 | +-------+ 16 | 17 | 18 | This file contains the bootstrap script for running the tests and starting up the UI. Can be loaded 19 | directory in lispworks. 20 | 21 | (load #P"./src/bootstrap.lisp") 22 | 23 | |# 24 | ; (setf *features* (cons :cl-opengl-no-check-error *features*)) 25 | 26 | ;; sunrise-109 This should likely go in .lispworks, but I don't want to depend 27 | ;; on folks having that set up properly. 28 | ;; https://www.lispworks.com/documentation/lw70/LW/html/lw-684.htm 29 | (lw:set-default-character-element-type 'character) 30 | 31 | (require "asdf") 32 | 33 | ;; By default (quicklisp-quickstart:install) puts it at something like "C:/Users//quicklisp/setup.lisp". 34 | ;; This will be in most lisp installations init scripts, but startup scripts aren't available in LW Personal 35 | ;; #+win32 (load (merge-pathnames #P"quicklisp/setup.lisp" (user-homedir-pathname))) 36 | 37 | 38 | (ql:quickload :cl-fad) 39 | (ql:quickload :log4cl) 40 | (ql:quickload :cffi) 41 | 42 | (log:config :info) 43 | 44 | (defvar *boxer-project-dir* 45 | (make-pathname :host (pathname-host *load-truename*) ; retain drive e.g. Z:/code/boxer-sunrise/ 46 | :directory (butlast (pathname-directory *load-truename*)))) 47 | 48 | (pushnew 49 | (cl-fad:merge-pathnames-as-directory *boxer-project-dir* "data/boxersunrise.app/Contents/Frameworks/") 50 | cffi:*foreign-library-directories* :test #'equal) 51 | 52 | #+win32 (pushnew *boxer-project-dir* 53 | cffi:*foreign-library-directories* :test #'equal) 54 | 55 | (setf asdf:*central-registry* 56 | (list* '*default-pathname-defaults* 57 | ;; This is relevant for compiled releases which include a "Plugins" subdir. 58 | ;; In development, cl-freetype2 goes into quicklisp/local-projects/; while this based on LW install 59 | ;; path may give something non-existent e.g. #P"C:/Program Files/PlugIns/cl-freetype2/". 60 | (make-pathname :host (pathname-host (lw:lisp-image-name)) 61 | :directory (append (butlast (pathname-directory (lw:lisp-image-name))) 62 | '("PlugIns" 63 | #+(and lispworks8 arm64) "lw8-macos-arm" 64 | "cl-freetype2"))) 65 | asdf:*central-registry*)) 66 | (log:debug "ASDF Registry: ~A" asdf:*central-registry*) 67 | 68 | (ql:quickload :cl-freetype2) 69 | 70 | (pushnew *boxer-project-dir* ql:*local-project-directories* ) 71 | (ql:register-local-projects) 72 | 73 | 74 | #+(and lispworks x64) (load (cl-fad:merge-pathnames-as-file *boxer-project-dir* "src/opengl-lw-8/examples/load.lisp")) 75 | 76 | 77 | ;; debugging on Apple Silicon 78 | ; #+ARM64 (progn 79 | ; ; (load "/Users/sgithens/code/lispworks-8.0-examples/opengl/host") 80 | ; (load "/Applications/LispWorks 8.0 (64-bit)/Library/lib/8-0-0-0/examples/opengl/host") 81 | ; (load "OPENGL:EXAMPLES;load")) 82 | 83 | (ql:quickload :boxer-sunrise-capi) 84 | (setf boxer::*capogi-font-directory* (merge-pathnames "data/boxersunrise.app/Contents/Resources/Fonts/" *boxer-project-dir*)) 85 | (setf boxer::*resources-dir* (merge-pathnames "data/boxersunrise.app/Contents/Resources/" *boxer-project-dir*)) 86 | (setf boxer::*shaders-dir* (merge-pathnames "src/draw-low-opengl330/shaders/" *boxer-project-dir*)) 87 | 88 | 89 | (boxer-window::window-system-specific-make-boxer) 90 | 91 | (boxer-window::window-system-specific-start-boxer) 92 | -------------------------------------------------------------------------------- /src/boxer-sunrise.lisp: -------------------------------------------------------------------------------- 1 | (defpackage boxer-sunrise 2 | (:use :cl)) 3 | (in-package :boxer-sunrise) 4 | 5 | ;; blah blah blah. 6 | -------------------------------------------------------------------------------- /src/boxwin/boxapp-data.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | ;;;; Support for recently opened files 18 | 19 | (in-package :boxer) 20 | 21 | (defvar *boxer-appdata-template* '( 22 | (:boxer-appdata . "Required for correct cl-json serialization") 23 | (:recent-files . ()))) 24 | 25 | (defvar *boxer-appdata* *boxer-appdata-template* 26 | "Data structure that will contain recently opened files, pinned files, 27 | and similar items.") 28 | 29 | (defvar *max-number-of-recent-files* 10 30 | "How many recent files to store by default") 31 | 32 | (defun get-boxapp-data-filepath () 33 | "This function retrieves the path on disk where a users appdata should be 34 | stored. This is OS specific, on MacOS it's typically something like 35 | `~/Library/Application Support/Boxer-data.lisp` and on Windows in the users local 36 | appdata directory" 37 | (merge-pathnames "Boxer/boxapp-data.lisp" 38 | #+(or macosx windows) (sys:get-folder-path :appdata) 39 | #+linux (uiop:xdg-config-home))) 40 | 41 | 42 | (defun load-appdata (&optional (filepath (get-boxapp-data-filepath))) 43 | "If this appdata file for boxer exists, we'll load the data from that, otherwise we'll 44 | use the default template aleady in *boxer-appdata*" 45 | ;; TODO: Think about, and add tests for if the data is corrupted or invalid. 46 | (if (probe-file filepath) 47 | (ignore-errors 48 | (with-open-file (s filepath :direction :input) 49 | (setf *boxer-appdata* (read s)))))) 50 | 51 | (defun save-appdata (&optional (filepath (get-boxapp-data-filepath))) 52 | "Saves the working Boxer data back to it's entry in the OS specific appdata location." 53 | (ensure-directories-exist filepath) 54 | (with-open-file (s filepath :direction :output :if-does-not-exist :create :if-exists :supersede) 55 | (write *boxer-appdata* :stream s))) 56 | 57 | (defun reset-recent-files () 58 | (setf (cdr (assoc :recent-files *boxer-appdata*)) '()) 59 | (save-appdata)) 60 | 61 | (defun get-recent-files () 62 | ;; TODO Remove files that may not exist according to probe-file 63 | (handler-case 64 | (let ((recent-files (cdr (assoc :recent-files *boxer-appdata*)))) 65 | (subseq recent-files 0 (if (< (length recent-files) *max-number-of-recent-files*) 66 | (length recent-files) 67 | *max-number-of-recent-files*))) 68 | (type-error (e) 69 | (format t "Error parsing recent files: ~A~%" e) 70 | (setf *boxer-appdata* *boxer-appdata-template*) 71 | '()))) 72 | 73 | (defun add-recent-file (path &optional label) 74 | ;; First remove any duplicates... 75 | (setf (cdr (assoc :recent-files *boxer-appdata*)) 76 | (remove-if #'(lambda (x) 77 | (uiop:pathname-equal path (cdr (assoc :path x)))) 78 | (cdr (assoc :recent-files *boxer-appdata*)))) 79 | 80 | ;; Then add it to the top of the list 81 | (push `((:path . ,path) 82 | (:label . ,path)) (cdr (assoc :recent-files *boxer-appdata*))) 83 | (assoc :recent-files *boxer-appdata*) 84 | (save-appdata)) 85 | -------------------------------------------------------------------------------- /src/boxwin/glfw/boxer-sunrise-glfw.asd: -------------------------------------------------------------------------------- 1 | (defsystem "boxer-sunrise-glfw" 2 | :version "3.4.23" 3 | :author "Steven Githens" 4 | :license "" 5 | :components ((:file "boxwin-glfw")) 6 | :depends-on (:cl-glfw3 7 | :boxer-sunrise 8 | :boxer-sunrise-redisplay)) 9 | -------------------------------------------------------------------------------- /src/boxwin/lw-capi/boxer-lw-opengl-canvas.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Lispworks CAPI customizations of boxer-canvas 17 | ;;;; 18 | (in-package :boxer-window) 19 | 20 | (defclass boxer-lw-opengl-canvas (opengl::opengl-pane boxer::boxer-canvas) 21 | ;; For some reason, I have to redefine configuration, context, and reader-state from capi.lisp in the 22 | ;; opengl examples for things to work on win32. On macOS they inherit fine. 23 | ((configuration :initform *default-opengl-pane-configuration* 24 | :initarg :configuration 25 | :reader configuration) 26 | (context :initform nil :initarg :context :accessor context) 27 | (render-state :initform nil :accessor opengl-pane-render-state))) 28 | 29 | (defmethod boxer::viewport-width ((self boxer-lw-opengl-canvas)) 30 | "Give the width of the port or widget container the Boxer documents canvas. Calculation will be different 31 | depending on the GL and Widget toolkit used. Needed for scrollbars, panning, and other types of interactions." 32 | (capi:simple-pane-visible-width self)) 33 | 34 | (defmethod boxer::viewport-height ((self boxer-lw-opengl-canvas)) 35 | "See viewport-width for description." 36 | (capi:simple-pane-visible-height self)) 37 | -------------------------------------------------------------------------------- /src/boxwin/lw-capi/boxer-sunrise-capi.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem "boxer-sunrise-capi" 2 | :version "3.4.23" 3 | :author "Steven Githens" 4 | :license "BSD-3-Clause" 5 | :depends-on ("boxer-sunrise" 6 | :boxer-sunrise-redisplay 7 | :boxer-sunrise-html-export 8 | :for) 9 | :components ((:file "error-dialogs") 10 | (:file "color-picker-menu") 11 | (:file "lw-toolbar") 12 | (:file "click-handlers") 13 | (:file "pane-callbacks") 14 | (:file "boxer-lw-opengl-canvas") 15 | (:file "scrolling") 16 | (:file "boxwin-opengl") 17 | (:file "clipboard") 18 | (:file "outline-tree") 19 | (:file "file-dialogs") 20 | (:file "lw-menu") 21 | (:file "preferences-dialog") 22 | (:file "confirm-quit-dialogs") 23 | ;; Bootstrap methods to startup boxer 24 | (:file "start-boxer")) 25 | :description "CAPI GUI version of Boxer") 26 | -------------------------------------------------------------------------------- /src/boxwin/lw-capi/clipboard.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Boxer 2 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 3 | ;;;; 4 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 5 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 6 | ;;;; 7 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 8 | ;;;; 9 | ;;;; https://opensource.org/licenses/BSD-3-Clause 10 | ;;;; 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Lispworks CAPI versions of Clipboard functionality 17 | ;;;; 18 | 19 | (in-package :boxer-lw-capi) 20 | 21 | ;; uncolor = result of color:unconvert-color which is a simple-vector with components of 22 | ;; :RGB, red, green, blue & alpha in 0->1.0 floa format 23 | (defun uncolor->pixel (uncolor) 24 | (flet ((convert-color-component (cc) 25 | (floor (* cc 255)))) 26 | (boxer::make-offscreen-pixel (convert-color-component (svref uncolor 1)) 27 | (convert-color-component (svref uncolor 2)) 28 | (convert-color-component (svref uncolor 3)) 29 | (convert-color-component (svref uncolor 4))))) 30 | 31 | ;;; capi:clipboard returns IMAGES 32 | (defun copy-image-to-bitmap (image bm w h) 33 | (let ((ia (gp:make-image-access bw::*boxer-pane* image)) 34 | (bdata (boxer::ogl-pixmap-data bm))) 35 | (unwind-protect 36 | (progn 37 | (gp::image-access-transfer-from-image ia) 38 | (dotimes (y h) 39 | (dotimes (x w) 40 | (setf 41 | (cffi:mem-aref bdata boxer::*pixmap-ffi-type* (+ x (* (- h y 1) w))) 42 | (uncolor->pixel 43 | (color:unconvert-color bw::*boxer-pane* (gp:image-access-pixel ia x y))))))) 44 | (gp:free-image-access ia)))) 45 | 46 | (defun image-to-bitmap (image) 47 | (unless (null image) 48 | (let* ((wid (gp:image-width image)) (hei (gp:image-height image)) 49 | (bim (boxer::make-ogl-pixmap wid hei))) 50 | (copy-image-to-bitmap image bim wid hei) 51 | (values bim wid hei)))) 52 | 53 | ;;; System clipboard 54 | 55 | (defun paste-text () 56 | (let ((string (capi::clipboard bw::*boxer-pane* :string))) 57 | (unless (null string) 58 | (dotimes (i (length string)) 59 | (let ((char (aref string i))) 60 | (if (member char '(#\Newline #\Return #\Linefeed)) 61 | (boxer::insert-row boxer::*point* 62 | (boxer::make-initialized-row) :moving) 63 | (boxer::insert-cha boxer::*point* char :moving))))))) 64 | 65 | (defun paste-pict (&optional (img (capi::clipboard bw::*boxer-pane* :image) 66 | img-supplied-p)) 67 | (multiple-value-bind (bm wid hei) 68 | (image-to-bitmap img) 69 | (unless (null bm) 70 | ;; memory leak ? 71 | (unless img-supplied-p (gp:free-image bw::*boxer-pane* img)) 72 | (let* ((gb (boxer::make-box '(()))) 73 | (gs (boxer::make-graphics-sheet wid hei gb))) 74 | (setf (boxer::graphics-sheet-bit-array gs) bm) 75 | (setf (boxer::graphics-info gb) gs) 76 | (setf (boxer::display-style-graphics-mode? 77 | (boxer::display-style-list gb)) T) 78 | (boxer::insert-cha boxer::*point* gb :moving))))) 79 | 80 | (defmethod paste ((self bw::boxer-frame)) 81 | (cond ((equal '(nil :lisp) (multiple-value-list (capi:clipboard-empty self :value))) 82 | ;; We are looking an undocumented multiple return value for type :value where 83 | ;; the second return value will be symbol :lisp if it came from lispworks. If 84 | ;; this is the case we know we were the last one to set the clipboard and yank 85 | ;; in our most recent item. 86 | ;; http://www.lispworks.com/documentation/lw71/CAPI-W/html/capi-w-206.htm#82688 87 | (boxer::com-paste)) 88 | ((not (capi:clipboard-empty self :string)) 89 | (paste-text)) 90 | ((not (capi:clipboard-empty self :image)) 91 | (paste-pict)) 92 | (t 93 | (boxer::com-paste)))) 94 | -------------------------------------------------------------------------------- /src/boxwin/lw-capi/color-picker-menu.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | ;;;; Reusable color dropdown menu to use for all the toolbar items that are colors, 18 | ;;;; such as font color, box background color, and box border colors. 19 | ;;;; 20 | (in-package :boxer-window) 21 | 22 | (defclass color-picker-menu (capi:option-pane) 23 | () 24 | (:default-initargs 25 | :visible-max-width '(:character 8) 26 | ;; We use the symbols for the colors, rather than the colors themselves since they 27 | ;; are likely not created yet at this point. 28 | :items (list (make-instance 'capi::menu-item 29 | :title "" :data nil) 30 | (make-instance 'capi::menu-item 31 | :title "Black" :data boxer::*black*) 32 | (make-instance 'capi::menu-item 33 | :title "White" :data boxer::*white*) 34 | (make-instance 'capi::menu-item 35 | :title "Red" :data boxer::*red*) 36 | (make-instance 'capi::menu-item 37 | :title "Green" :data boxer::*green*) 38 | (make-instance 'capi::menu-item 39 | :title "Blue" :data boxer::*blue*) 40 | (make-instance 'capi::menu-item 41 | :title "Cyan" :data boxer::*cyan*) 42 | (make-instance 'capi::menu-item 43 | :title "Magenta" :data boxer::*magenta*) 44 | (make-instance 'capi::menu-item 45 | :title "Yellow" :data boxer::*yellow*) 46 | (make-instance 'capi::menu-item 47 | :title "Orange" :data boxer::*orange*) 48 | (make-instance 'capi::menu-item 49 | :title "Purple" :data boxer::*purple*) 50 | (make-instance 'capi::menu-item 51 | :title "Gray" :data boxer::*gray*)))) 52 | -------------------------------------------------------------------------------- /src/boxwin/lw-capi/error-dialogs.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Boxer 2 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 3 | ;;;; 4 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 5 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 6 | ;;;; 7 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 8 | ;;;; 9 | ;;;; https://opensource.org/licenses/BSD-3-Clause 10 | ;;;; 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Error Dialogs for showing backtraces and restart/quit options 17 | ;;;; 18 | (in-package :boxer-window) 19 | 20 | (capi:define-interface error-dialog () 21 | () 22 | (:panes 23 | (logo capi:output-pane 24 | :display-callback 'load-boxer-logo 25 | :visible-min-width 128 26 | :visible-min-height 128) 27 | (message capi:message-pane 28 | ::visible-min-height '(:character 7) 29 | :text 30 | "Boxer encountered an error in its own code. 31 | 32 | Below is detailed information you can report to the Boxer team to help fix the issue. 33 | 34 | You can try to restart Boxer, but some bugs may be persistent, and (rarely) might 35 | spoil your Boxer world. Quitting is a reliable fresh start.") 36 | (backtrace capi:editor-pane 37 | :flag 'minimal-example 38 | :text "This is the backtrace" 39 | :buffer-name :TEMP 40 | :enabled :read-only 41 | :visible-min-width '(character 80) 42 | :visible-min-height '(character 15) 43 | :visible-max-width '(character 80) 44 | :visible-max-height '(character 15)) 45 | (copy-backtrace capi:push-button 46 | :text "Copy Error to Clipboard" 47 | :callback #'(lambda (data int) 48 | (capi:set-clipboard int (capi:editor-pane-text backtrace)))) 49 | (continue capi:push-button 50 | :text "Restart" 51 | :callback #'(lambda (data int) 52 | (capi:exit-dialog :continue))) 53 | (quit capi:push-button 54 | :text "Quit Boxer" 55 | :callback #'(lambda (data int) 56 | (capi:exit-dialog :quit))) 57 | ) 58 | (:layouts 59 | (dialog capi:row-layout 60 | '(logo controls) 61 | :gap 20) 62 | (controls capi:column-layout 63 | '(message backtrace buttons)) 64 | (buttons capi:row-layout 65 | '(nil copy-backtrace continue quit) 66 | :ratios '(20 1 1 1)) 67 | ) 68 | (:default-initargs 69 | :title "Boxer Error" 70 | :background :transparent 71 | :visible-border t)) 72 | 73 | (defun load-boxer-logo (pane x y wid hei) 74 | (with-slots (logo) (capi:top-level-interface pane) 75 | (gp:draw-image logo 76 | (gp:load-image pane 77 | (gp:read-external-image 78 | (cl-fad:merge-pathnames-as-file boxer::*resources-dir* "images/boxer-sunrise-icon.png"))) 0 0))) 79 | 80 | (defun show-error-dialog (error-description) 81 | (let ((dialog (make-instance 'error-dialog))) 82 | (setf (capi:editor-pane-text (slot-value dialog 'backtrace)) error-description) 83 | (case (capi:display-dialog dialog :owner *boxer-pane*) 84 | (:continue 85 | (invoke-restart 'BOXER-CONTINUE)) 86 | (:quit 87 | (lw:quit))))) 88 | -------------------------------------------------------------------------------- /src/boxwin/lw-capi/file-dialogs.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Boxer 2 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 3 | ;;;; 4 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 5 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 6 | ;;;; 7 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 8 | ;;;; 9 | ;;;; https://opensource.org/licenses/BSD-3-Clause 10 | ;;;; 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | 17 | (in-package :boxer-window) 18 | 19 | ;;; File System Helpers 20 | 21 | (defvar *boxer-file-filters* '("Box Files" "*.box;*.box~;*.box#;*.boxer" "All Files" "*.*")) 22 | (defvar *boxer-save-file-filters* 23 | '("Box File 98-2022" "*.box" 24 | "Boxer Document" "*.boxer" 25 | "All Files" "*.*") 26 | "For saving files, we want to keep .box and .boxer separate so the user can choose 27 | between them." 28 | ) 29 | 30 | 31 | ;; mac legacy vars, see boxer-new-file-dialog for usage 32 | (defvar *save-file-format* :BOXR) 33 | (defvar *dialog-ro* 0) 34 | 35 | (defun boxer::boxer-open-file-dialog (&key (prompt "Open File:") directory) 36 | (multiple-value-bind (path success?) 37 | (capi:prompt-for-file prompt :filters *boxer-file-filters* 38 | :pathname (merge-pathnames 39 | (or directory "") 40 | boxer::*boxer-pathname-default*) 41 | :operation :open :owner *boxer-frame*) 42 | (if (null success?) 43 | (throw 'boxer::cancel-boxer-file-dialog nil) 44 | path))) 45 | 46 | (defun boxer::boxer-open-lost-file-dialog (&key (prompt "Can't find") directory) 47 | (let ((missing-text (or (and directory 48 | (format nil "~A ~A. Please locate file:" 49 | prompt (file-namestring directory))) 50 | (format nil "~A box file. Please locate file:" prompt)))) 51 | (multiple-value-bind (path success?) 52 | (capi:prompt-for-file missing-text :filters *boxer-file-filters* 53 | :operation :open 54 | :pathname (merge-pathnames 55 | (or directory "") 56 | boxer::*boxer-pathname-default*) 57 | :owner *boxer-frame*) 58 | (if (null success?) 59 | (throw 'boxer::cancel-boxer-file-dialog nil) 60 | path)))) 61 | 62 | ;; on the mac, *save-file-format* and *dialog-ro* can be side-effected by the 63 | ;; custom dialog 64 | (defun boxer::boxer-new-file-dialog (&key (prompt "Save As") directory box 65 | no-read-only?) 66 | (unless (null box) 67 | (setq *save-file-format* (or (boxer::getprop box :preferred-file-format) 68 | :boxer) 69 | *dialog-ro* (if (and (null no-read-only?) (boxer::read-only-box? box)) 70 | 1 0))) 71 | (multiple-value-bind (path success?) 72 | (capi:prompt-for-file prompt 73 | :filters *boxer-save-file-filters* 74 | :pathname (boxer::untitled-filename 75 | (cl-fad:merge-pathnames-as-directory 76 | (or directory 77 | (cl-fad:merge-pathnames-as-directory boxer::*boxer-pathname-default*)))) 78 | :operation :save 79 | :if-does-not-exist :ok :owner *boxer-frame*) 80 | (if (null success?) 81 | (throw 'boxer::cancel-boxer-file-dialog nil) 82 | path))) 83 | -------------------------------------------------------------------------------- /src/boxwin/lw-capi/pane-callbacks.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | ;;;; 18 | 19 | (in-package :boxer-window) 20 | 21 | (defparameter *boxer-pane-initialized* nil) 22 | 23 | (defun boxer-pane-display-callback (canvas x y wid hei) 24 | ;; canvas ignore 25 | 26 | (unless *boxer-pane-initialized* 27 | ;; modernGL inits 28 | (opengl:rendering-on (*boxer-pane*) 29 | (boxer-opengl::opengl-enables) 30 | 31 | (setf bw::*boxgl-device* (boxer-opengl::make-boxgl-device wid hei)) 32 | 33 | (gl-reshape wid hei) 34 | (update-gpu-matrices) 35 | (set-pen-color box::*foreground-color*)) 36 | 37 | (boxer::initialize-fonts) 38 | 39 | (let ((boxer::%private-graphics-list nil)) 40 | ;; needed by shape-box updater in the redisplay inits but not set until 41 | ;; (boxer-eval::setup-evaluator) farther down 42 | (run-redisplay-inits)) 43 | (setf *boxer-pane-initialized* t) 44 | 45 | (opengl:rendering-on (*boxer-pane*) 46 | (log:debug "~%max-texture-size: ~A" (gl:get-integer :max-texture-size)) 47 | (init-freetype-fonts) 48 | (log:debug "~%Just created texture atlas"); boxer::*freetype-glyph-atlas*) 49 | ) 50 | )) 51 | -------------------------------------------------------------------------------- /src/boxwin/text-repl/boxer-sunrise-text-repl.asd: -------------------------------------------------------------------------------- 1 | (defsystem "boxer-sunrise-text-repl" 2 | :version "3.4.23" 3 | :author "Steven Githens" 4 | :license "" 5 | :components ((:file "boxwin-text-repl")) 6 | :depends-on (:boxer-sunrise 7 | :boxer-sunrise-redisplay)) 8 | -------------------------------------------------------------------------------- /src/boxwin/text-repl/boxwin-text-repl.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Boxer Text REPL 17 | ;;;; Primarily used for testing separeation of the evaluation engine and the graphics layer 18 | (in-package :boxer-window) 19 | 20 | (defclass text-repl-boxer-pane (boxer::boxer-canvas) 21 | ()) 22 | 23 | (defmethod boxer::viewport-width ((self text-repl-boxer-pane)) 24 | 100) 25 | 26 | (defmethod boxer::viewport-height ((self text-repl-boxer-pane)) 27 | 100) 28 | 29 | (defclass test-repl-boxer-name-pane () 30 | ()) 31 | 32 | (defun window-system-specific-make-boxer () 33 | (setf *boxer-pane* (make-instance 'text-repl-boxer-pane) ;(slot-value *boxer-frame* 'boxer-pane) 34 | *name-pane* (make-instance 'test-repl-boxer-name-pane) ;(slot-value *boxer-frame* 'name-pane) 35 | (boxer::point-blinker *boxer-pane*) (boxer::make-blinker)) 36 | 37 | (boxer::initialize-fonts) 38 | (progn ;; moved here because FD's need init'd colors 39 | (setq boxer::*default-font-descriptor* (boxer::make-bfd -1 boxer::*default-font*) 40 | boxer::*current-font-descriptor* (boxer::make-bfd -1 boxer::*default-font*)))) 41 | 42 | (defun window-system-specific-start-boxer () 43 | (setq boxer-eval::*current-process* nil) 44 | (setup-editor boxer::*initial-box*) 45 | (boxer-eval::setup-evaluator) 46 | (unless boxer::*boxer-version-info* 47 | (setq boxer::*boxer-version-info* 48 | (format nil "~:(~A~) Boxer" (machine-instance)))) 49 | 50 | ;;; START contents of boxer-process-top-level-fn 51 | (boxer::enter (boxer::point-box))) 52 | 53 | (defun start-text-repl-boxer (project-dir) 54 | (format t "~%Preparing Hello text repl boxer5!") 55 | (window-system-specific-make-boxer) 56 | (window-system-specific-start-boxer) 57 | (setf bw::*boxgl-device* (make-instance 'boxgl-device)) 58 | (setf 59 | (boxgl-device-projection-matrix bw::*boxgl-device*) 60 | (create-ortho-matrix 800 600) 61 | 62 | (boxgl-device-transform-matrix bw::*boxgl-device*) 63 | (create-transform-matrix 0 0) 64 | 65 | (boxgl-device-pen-color bw::*boxgl-device*) 66 | #(:rgb 0.0 0.0 0.0 1.0) 67 | 68 | (boxgl-device-pen-size bw::*boxgl-device*) 69 | 1) 70 | 71 | (format t "~%Initial box: ~%~A" (boxer::textify-thing boxer::*initial-box*)) 72 | (boxer::repaint-guts) 73 | (handle-boxer-input #\B) 74 | (handle-boxer-input #\o) 75 | (handle-boxer-input #\x) 76 | (handle-boxer-input #\R) 77 | (handle-boxer-input #\E) 78 | (handle-boxer-input #\P) 79 | (handle-boxer-input #\L) 80 | (format t "~%Initial box: ~%~A" (boxer::textify-thing boxer::*initial-box*)) 81 | (boxer::repaint-guts)) 82 | -------------------------------------------------------------------------------- /src/boxwin/threejs/boxer-sunrise-threejs.asd: -------------------------------------------------------------------------------- 1 | (defsystem "boxer-sunrise-threejs" 2 | :version "3.4.23" 3 | :author "Steven Githens" 4 | :license "" 5 | :components ((:file "boxwin-threejs") 6 | (:file "threejs-draw-bridge")) 7 | :depends-on (:boxer-sunrise)) 8 | -------------------------------------------------------------------------------- /src/boxwin/threejs/boxwin-threejs.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Boxer Three JS 17 | ;;;; 18 | (in-package :boxer-window) 19 | 20 | (defclass threejs-boxer-pane (boxer::boxer-canvas) 21 | ()) 22 | 23 | (defmethod boxer::viewport-width ((self threejs-boxer-pane)) 24 | 800) 25 | 26 | (defmethod boxer::viewport-height ((self threejs-boxer-pane)) 27 | 600) 28 | 29 | (defclass threejs-boxer-name-pane () 30 | ()) 31 | 32 | (defun window-system-specific-make-boxer () 33 | (setf *boxer-pane* (make-instance 'threejs-boxer-pane) ;(slot-value *boxer-frame* 'boxer-pane) 34 | *name-pane* (make-instance 'threejs-boxer-name-pane) ;(slot-value *boxer-frame* 'name-pane) 35 | (boxer::point-blinker *boxer-pane*) (boxer::make-blinker)) 36 | 37 | (boxer::initialize-fonts) 38 | (progn ;; moved here because FD's need init'd colors 39 | (setq boxer::*default-font-descriptor* (boxer::make-bfd -1 boxer::*default-font*) 40 | boxer::*current-font-descriptor* (boxer::make-bfd -1 boxer::*default-font*)))) 41 | 42 | (defun window-system-specific-start-boxer () 43 | (setq boxer-eval::*current-process* nil) 44 | (setup-editor boxer::*initial-box*) 45 | (boxer-eval::setup-evaluator) 46 | (unless boxer::*boxer-version-info* 47 | (setq boxer::*boxer-version-info* 48 | (format nil "~:(~A~) Boxer" (machine-instance)))) 49 | 50 | ;;; START contents of boxer-process-top-level-fn 51 | (boxer::enter (boxer::point-box))) 52 | 53 | (defun start-threejs-boxer (project-dir) 54 | (format t "~%Preparing three.js Boxer 1.1!") 55 | (window-system-specific-make-boxer) 56 | (window-system-specific-start-boxer) 57 | (setf bw::*boxgl-device* (make-instance 'boxgl-device)) 58 | (setf 59 | (boxgl-device-projection-matrix bw::*boxgl-device*) 60 | (create-ortho-matrix 800 600) 61 | 62 | (boxgl-device-transform-matrix bw::*boxgl-device*) 63 | (create-transform-matrix 0 0) 64 | 65 | (boxgl-device-pen-color bw::*boxgl-device*) 66 | #(:rgb 0.0 0.0 0.0 1.0) 67 | 68 | (boxgl-device-pen-size bw::*boxgl-device*) 69 | 1) 70 | 71 | (format t "~%Initial box: ~%~A" (boxer::textify-thing boxer::*initial-box*)) 72 | (boxer::repaint-guts) 73 | (handle-boxer-input #\B) 74 | (handle-boxer-input #\o) 75 | (handle-boxer-input #\x) 76 | (handle-boxer-input #\-) 77 | (handle-boxer-input #\3) 78 | (handle-boxer-input #\J) 79 | (handle-boxer-input #\S) 80 | ;; (format t "~%Initial box: ~%~A" (boxer::textify-thing boxer::*initial-box*)) 81 | (boxer::repaint-guts)) 82 | -------------------------------------------------------------------------------- /src/boxwin/threejs/threejs-draw-bridge.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Emtpy stubs of draw functions 17 | ;;;; 18 | (in-package :boxer-draw-bridge) 19 | 20 | ;; %bitblt-to-screen wid hei from-array from-x from-y to-x to-y)) 21 | ;; %buffer-canvas-mesh device mesh pixmap wid hei)) 22 | 23 | (defun %cha-wid (char) 24 | 20) 25 | 26 | (defun %clear-window (color) 27 | nil) 28 | 29 | ;; %draw-c-arc x y radius start-angle sweep-angle filled?)) 30 | ;; %draw-canvas-mesh mesh pixmap)) 31 | 32 | (defun %draw-cha (char x y &key (gl-model nil)) 33 | nil) 34 | 35 | ;; %draw-circle x y radius filled?)) 36 | ;; %draw-ellipse x y width height filled?)) 37 | ;; %draw-line x0 y0 x1 y1)) 38 | 39 | (defun %draw-line (x0 y0 x1 y1) 40 | (format t "~%draw-line4: ~A ~A ~A ~A" x0 y0 x1 y1) 41 | (cl-user::three-draw-line (floor x0) (floor y0) (floor x1) (floor y1))) 42 | 43 | ;; %draw-poly points)) 44 | 45 | (defun %draw-rectangle (w h x y) 46 | nil) 47 | 48 | (defun %draw-string (font-no string region-x region-y) 49 | nil) 50 | 51 | ;; %flush-port-buffer pane)) 52 | ;; %get-pixel view (floor x) (floor y)))) 53 | 54 | (defun %set-pen-color (color) 55 | nil) 56 | 57 | (defun %string-ascent (font-no) 58 | 20) 59 | 60 | (defun %string-hei (font-no) 61 | 20) 62 | 63 | (defun %string-wid (font-no string) 64 | 50) 65 | 66 | ;; cur-tick)) 67 | ;; disable paint-tex)) 68 | ;; enable paint-tex) 69 | ;; graphics-canvas-pixmap paint-tex)))) 70 | ;; ignore-stencil))))) 71 | ;; line-stipple bw::*boxgl-device*))) 72 | ;; load-freetype-faces) 73 | 74 | (defun %pixblt-from-screen (pixmap fx fy wid hei) 75 | nil) 76 | 77 | (defun %make-boxer-gl-model () 78 | (make-instance 'boxer:boxer-gl-model)) 79 | 80 | (defun %find-glyph (spec) 81 | nil) 82 | 83 | ;; make-glyph-atlas))) 84 | ;; make-graphics-canvas (ogl-pixmap-width ,bitmap) (ogl-pixmap-height ,bitmap) ,bitmap))) 85 | ;; needs-update model) nil) 86 | ;; needs-update obj)) 87 | ;; ogl-reshape window-width window-height)) 88 | ;; opengl-enables) 89 | ;; render-inside-stencil))) 90 | 91 | ;; update-matrices-ubo bw::*boxgl-device*)) 92 | ;; update-model-matrix-ubo bw::*boxgl-device*)) 93 | (defun %refresh-gpu-model-matrix () 94 | nil) 95 | 96 | ;; update-transform-matrix-ubo self)) 97 | ;; write-to-stencil) 98 | ;; *freetype-glyph-atlas* ( 99 | -------------------------------------------------------------------------------- /src/definitions/3d-math.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :3d-vectors 2 | (:use :cl) 3 | (:export 4 | :vec3 5 | :vec 6 | :vx3 7 | :vy3 8 | :vz3 9 | :+vx+ 10 | :+vy+ 11 | :+vz+ 12 | :nv+ 13 | :nv* 14 | :nvrot)) 15 | 16 | (in-package :3d-vectors) 17 | 18 | (declaim (inline %vec3)) 19 | (defstruct (vec3 (:conc-name NIL) 20 | (:constructor %vec3 (%vx3 %vy3 %vz3)) 21 | (:copier vcopy3) 22 | (:predicate vec3-p)) 23 | (%vx3 (ensure-float 0) :type single-float) 24 | (%vy3 (ensure-float 0) :type single-float) 25 | (%vz3 (ensure-float 0) :type single-float)) 26 | 27 | (defun vec (x y z) 28 | (%vec3 (coerce x 'single-float) (coerce y 'single-float) (coerce z 'single-float))) 29 | 30 | (defun vx3 (v) 31 | (%vx3 v)) 32 | 33 | (defun vy3 (v) 34 | (%vy3 v)) 35 | 36 | (defun vz3 (v) 37 | (%vz3 v)) 38 | 39 | 40 | (defparameter +vx+ (vec 1.0 0.0 0.0)) 41 | (defparameter +vy+ (vec 0.0 1.0 0.0)) 42 | (defparameter +vz+ (vec 0.0 0.0 1.0)) 43 | 44 | (defun nv+ (vec1 vec2) 45 | (setf (vx3 vec1) (+ (vx3 vec1) (vx3 vec2)) 46 | (vy3 vec1) (+ (vy3 vec1) (vy3 vec2)) 47 | (vz3 vec1) (+ (vz3 vec1) (vz3 vec2)))) 48 | 49 | (defun nv* (vec1 scale) 50 | (setf (vx3 vec1) (* (vx3 vec1) scale) 51 | (vy3 vec1) (* (vy3 vec1) scale) 52 | (vz3 vec1) (* (vz3 vec1) scale))) 53 | 54 | (defun nvrot (v axi phi) 55 | "STUB" 56 | v) 57 | 58 | (defpackage :3d-matrices 59 | (:use :cl) 60 | (:export 61 | :mat4 62 | :marr4 63 | :meye 64 | :m* 65 | :mortho 66 | :mperspective 67 | :mtranslation 68 | :mtranspose 69 | :nmrotate 70 | :nmscale 71 | :nmtranslate)) 72 | 73 | (in-package :3d-matrices) 74 | 75 | (declaim (inline %mat4)) 76 | (defstruct (mat4 (:conc-name NIL) 77 | (:constructor %mat4 (marr4)) 78 | (:copier NIL) 79 | (:predicate mat4-p)) 80 | (marr4 NIL )) ; :type (simple-array single-float (16)) 81 | 82 | (defun mat4 (v) 83 | (%mat4 (copy-seq v))) 84 | 85 | (defun meye (n) 86 | (%mat4 #(1.0 0.0 0.0 0.0 87 | 0.0 1.0 0.0 0.0 88 | 0.0 0.0 1.0 0.0 89 | 0.0 0.0 0.0 1.0))) 90 | 91 | (defun m* (mat1 mat2) 92 | "STUB" 93 | mat1) 94 | 95 | (defun mortho (left right bottom top near far) 96 | "STUB" 97 | (meye 4)) 98 | 99 | (defun mperspective (fovy aspect near far) 100 | "STUB" 101 | (meye 4)) 102 | 103 | (defun mtranslation (v) 104 | "STUB" 105 | (meye 4)) 106 | 107 | (defun mtranspose (m) 108 | "STUB" 109 | (meye 4)) 110 | 111 | (defun nmrotate (m v angle) 112 | "STUB" 113 | (meye 4)) 114 | 115 | (defun nmscale (m v) 116 | "STUB" 117 | (meye 4)) 118 | 119 | (defun nmtranslate (m v) 120 | "STUB" 121 | (meye 4)) 122 | -------------------------------------------------------------------------------- /src/definitions/boxlog.lisp: -------------------------------------------------------------------------------- 1 | ;; This is a temporary workaround for ecl/emscripten which does not 2 | ;; support bordeaux-threads and anything that depends on it like cl-fad, 3 | ;; log4cl, etc 4 | 5 | (defun log:config (level) 6 | nil) 7 | 8 | (defun log:debug (msg &rest params) 9 | nil) 10 | 11 | (defun log:info (msg &rest params) 12 | nil) 13 | 14 | (defun log:error (msg &rest params) 15 | nil) 16 | 17 | (defun log:warn (msg &rest params) 18 | nil) 19 | -------------------------------------------------------------------------------- /src/delivery-script.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | Boxer 3 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | 5 | Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | 8 | Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | 10 | https://opensource.org/licenses/BSD-3-Clause 11 | 12 | 13 | +-Data--+ 14 | This file is part of the | BOXER | system 15 | +-------+ 16 | 17 | 18 | This file contains the delivery script for building boxer executables. 19 | 20 | |# 21 | 22 | ; http://www.lispworks.com/documentation/lw71/DV/html/delivery-198.htm 23 | 24 | ;; sunrise-109 This should likely go in .lispworks, but I don't want to depend 25 | ;; on folks having that set up properly. 26 | ;; https://www.lispworks.com/documentation/lw70/LW/html/lw-684.htm 27 | (lw:set-default-character-element-type 'character) 28 | 29 | ;; TODO The Application Builder tool doesn't seem to be loading the initialization file... 30 | #+win32 (load "Z:/quicklisp/setup.lisp") 31 | 32 | (in-package "CL-USER") 33 | (load-all-patches) 34 | (require :asdf) 35 | 36 | (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) 37 | (when (probe-file quicklisp-init) 38 | (load quicklisp-init))) 39 | 40 | (defvar *boxer-project-dir* (make-pathname :directory (butlast (pathname-directory *load-truename*)))) 41 | 42 | (setf asdf:*central-registry* 43 | (list* '*default-pathname-defaults* 44 | *boxer-project-dir* 45 | #+win32 #P"z:/code/boxer-sunrise/" ; TODO Sorting out path functions on win32... 46 | asdf:*central-registry*)) 47 | 48 | ; (load (example-file "opengl/examples/load")) 49 | (ql:quickload :cl-fad) 50 | #+(and lispworks x64 macosx) (load (cl-fad:merge-pathnames-as-file *boxer-project-dir* "src/opengl-lw-8/examples/load.lisp")) 51 | #+(and lispworks x64 win32) (load #P"z:/code/boxer-sunrise/src/opengl-lw-8/examples/load.lisp") 52 | 53 | (setf *features* (cons :delivering *features*)) 54 | 55 | (ql:quickload :log4cl) 56 | (ql:quickload :drakma) 57 | ;; (ql:quickload :cl-json) 58 | (ql:quickload :zpng) 59 | (ql:quickload :qbase64) 60 | (ql:quickload :html-entities) 61 | (ql:quickload :quri) 62 | 63 | ;; Loading these freetype2 dependencies so they are available when we manually 64 | ;; load the freetype compiles filed during startup. 65 | (ql:quickload :alexandria) 66 | (ql:quickload :trivial-garbage) 67 | (ql:quickload :cffi) 68 | (ql:quickload :zip) 69 | 70 | (ql:quickload :cl-opengl) 71 | (ql:quickload :pngload) 72 | (ql:quickload :3d-vectors) 73 | (ql:quickload :3d-matrices) 74 | (ql:quickload :iterate) 75 | (ql:quickload :for) 76 | 77 | ;; (ql:quickload :cl-freetype2) 78 | 79 | (asdf:load-system :boxer-sunrise-capi) 80 | 81 | (deliver 'boxer::start-boxer 82 | ;; We are currently using a custom tailored application folder template, that was 83 | ;; originally created using this method, but we've made customizations to. At some 84 | ;; point we could refine this to create the final app bundle with all our customizations 85 | ;; on each run, rather than having to maintain our own copy. We do have to add our 86 | ;; current set of fonts, and icons to it. Other than that we have some random property 87 | ;; changes in the Info.plist. 88 | ;; #+:cocoa 89 | ;; (create-macos-application-bundle 90 | ;; (merge-pathnames "./data/boxersunrise.app" (uiop:getcwd)) 91 | ;; ;; Do not copy file associations... 92 | ;; :document-types nil 93 | ;; ;; ...or CFBundleIdentifier from the LispWorks bundle 94 | ;; :identifier "org.boxer.BoxerSunrise" 95 | ;; ) 96 | 97 | ;; TODO still working on getting these paths sorted out on win32, unfortunately hardcoded at the moment. 98 | #+win32 #P"z:/code/boxer-sunrise/data/boxer-sunrise/boxersunrise.exe" 99 | #+mac (cl-fad:merge-pathnames-as-file *boxer-project-dir* "data/boxersunrise.app/Contents/MacOS/boxersunrise") 100 | 0 :interface :capi 101 | :keep-pretty-printer t 102 | :startup-bitmap-file nil 103 | :split t 104 | ) 105 | -------------------------------------------------------------------------------- /src/draw-low-empty/empty-draw-bridge.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Emtpy stubs of draw functions 17 | ;;;; 18 | (in-package :boxer-draw-bridge) 19 | 20 | ;; %bitblt-to-screen wid hei from-array from-x from-y to-x to-y)) 21 | ;; %buffer-canvas-mesh device mesh pixmap wid hei)) 22 | 23 | (defun %cha-wid (char) 24 | 10) 25 | 26 | (defun %clear-window (color) 27 | nil) 28 | 29 | ;; %draw-c-arc x y radius start-angle sweep-angle filled?)) 30 | ;; %draw-canvas-mesh mesh pixmap)) 31 | 32 | (defun %draw-cha (char x y &key (gl-model nil)) 33 | nil) 34 | 35 | ;; %draw-circle x y radius filled?)) 36 | ;; %draw-ellipse x y width height filled?)) 37 | ;; %draw-line x0 y0 x1 y1)) 38 | 39 | (defun %draw-line (x0 y0 x1 y1) 40 | nil) 41 | 42 | ;; %draw-poly points)) 43 | 44 | (defun %draw-rectangle (w h x y) 45 | nil) 46 | 47 | (defun %draw-string (font-no string region-x region-y) 48 | nil) 49 | 50 | ;; %flush-port-buffer pane)) 51 | ;; %get-pixel view (floor x) (floor y)))) 52 | 53 | (defun %set-pen-color (color) 54 | nil) 55 | 56 | (defun %string-ascent (font-no) 57 | 10) 58 | 59 | (defun %string-hei (font-no) 60 | 10) 61 | 62 | (defun %string-wid (font-no string) 63 | 10) 64 | 65 | ;; cur-tick)) 66 | ;; disable paint-tex)) 67 | ;; enable paint-tex) 68 | ;; graphics-canvas-pixmap paint-tex)))) 69 | ;; ignore-stencil))))) 70 | ;; line-stipple bw::*boxgl-device*))) 71 | ;; load-freetype-faces) 72 | 73 | (defun %pixblt-from-screen (pixmap fx fy wid hei) 74 | nil) 75 | 76 | (defun %make-boxer-gl-model () 77 | (make-instance 'boxer:boxer-gl-model)) 78 | 79 | (defun %find-glyph (spec) 80 | nil) 81 | 82 | ;; make-glyph-atlas))) 83 | ;; make-graphics-canvas (ogl-pixmap-width ,bitmap) (ogl-pixmap-height ,bitmap) ,bitmap))) 84 | ;; needs-update model) nil) 85 | ;; needs-update obj)) 86 | ;; ogl-reshape window-width window-height)) 87 | ;; opengl-enables) 88 | ;; render-inside-stencil))) 89 | 90 | ;; update-matrices-ubo bw::*boxgl-device*)) 91 | ;; update-model-matrix-ubo bw::*boxgl-device*)) 92 | (defun %refresh-gpu-model-matrix () 93 | nil) 94 | 95 | ;; update-transform-matrix-ubo self)) 96 | ;; write-to-stencil) 97 | ;; *freetype-glyph-atlas* ( 98 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/boxer-sunrise-opengl.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem "boxer-sunrise-opengl" 2 | :version "3.4.23" 3 | :author "Steven Githens" 4 | :license "BSD-3-Clause" 5 | :depends-on (:boxer-sunrise-core 6 | :3d-matrices 7 | :cl-opengl 8 | :cl-freetype2 9 | :for) 10 | :components ((:file "package") 11 | (:file "pixmap") 12 | (:file "stencils") 13 | (:file "graphics-canvas") 14 | ;; (:file "simple-line-shapes") 15 | (:file "line-shapes") 16 | (:file "shader-shapes") 17 | (:file "box-models-meshes") 18 | (:file "draw-low-opengl330") 19 | #+(not delivering) 20 | (:file "freetype-fonts") 21 | (:file "draw-low-opengl") 22 | (:file "opengl-draw-bridge") 23 | (:file "perspective")) 24 | :description "OpenGL Implementation of Boxer Rendering") 25 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/opengl-draw-bridge.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Boxer 2 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 3 | ;;;; 4 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 5 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 6 | ;;;; 7 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 8 | ;;;; 9 | ;;;; https://opensource.org/licenses/BSD-3-Clause 10 | ;;;; 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; 17 | ;;;; OpenGL implementation of draw functions. 18 | ;;;; 19 | (in-package :boxer-draw-bridge) 20 | 21 | ;; %bitblt-to-screen wid hei from-array from-x from-y to-x to-y)) 22 | ;; %buffer-canvas-mesh device mesh pixmap wid hei)) 23 | 24 | (defun %cha-wid (char) 25 | (boxer-opengl::%cha-wid char)) 26 | 27 | (defun %clear-window (color) 28 | (boxer-opengl::%clear-window color)) 29 | 30 | ;; %draw-c-arc x y radius start-angle sweep-angle filled?)) 31 | ;; %draw-canvas-mesh mesh pixmap)) 32 | 33 | (defun %draw-cha (char x y &key (gl-model nil)) 34 | (boxer-opengl::%draw-cha char x y :gl-model gl-model)) 35 | 36 | ;; %draw-circle x y radius filled?)) 37 | ;; %draw-ellipse x y width height filled?)) 38 | ;; %draw-line x0 y0 x1 y1)) 39 | 40 | (defun %draw-line (x0 y0 x1 y1) 41 | (boxer-opengl::%draw-line x0 y0 x1 y1)) 42 | 43 | ;; %draw-poly points)) 44 | ;; %draw-rectangle w h x y))) 45 | 46 | (defun %draw-rectangle (w h x y) 47 | (boxer-opengl::%draw-rectangle w h x y)) 48 | 49 | (defun %draw-string (font-no string region-x region-y) 50 | (boxer-opengl::%draw-string font-no string region-x region-y)) 51 | 52 | ;; %flush-port-buffer pane)) 53 | ;; %get-pixel view (floor x) (floor y)))) 54 | 55 | (defun %set-pen-color (color) 56 | (boxer-opengl::%set-pen-color color)) 57 | 58 | (defun %string-ascent (font-no) 59 | (boxer-opengl::%string-ascent font-no)) 60 | 61 | (defun %string-hei (font-no) 62 | (boxer-opengl::%string-hei font-no)) 63 | 64 | (defun %string-wid (font-no string) 65 | (boxer-opengl::%string-wid font-no string)) 66 | 67 | ;; disable paint-tex)) 68 | ;; enable paint-tex) 69 | ;; graphics-canvas-pixmap paint-tex)))) 70 | ;; ignore-stencil))))) 71 | ;; line-stipple bw::*boxgl-device*))) 72 | ;; load-freetype-faces) 73 | ;; make-boxer-gl-model) :gl-model) 74 | 75 | (defun %pixblt-from-screen (pixmap fx fy wid hei) 76 | (boxer-opengl::%pixblt-from-screen pixmap fx fy wid hei)) 77 | 78 | (defun %make-boxer-gl-model () 79 | (boxer-opengl::make-boxer-opengl-model)) 80 | 81 | (defun %find-glyph (spec) 82 | (boxer-opengl::get-glyph boxer-opengl::*freetype-glyph-atlas* spec)) 83 | 84 | ;; make-glyph-atlas))) 85 | ;; make-graphics-canvas (ogl-pixmap-width ,bitmap) (ogl-pixmap-height ,bitmap) ,bitmap))) 86 | ;; ogl-reshape window-width window-height)) 87 | ;; opengl-enables) 88 | ;; render-inside-stencil))) 89 | 90 | ;; update-matrices-ubo bw::*boxgl-device*)) 91 | 92 | (defun %refresh-gpu-model-matrix () 93 | (boxer-opengl::update-model-matrix-ubo bw::*boxgl-device*)) 94 | 95 | ;; update-transform-matrix-ubo self)) 96 | ;; write-to-stencil) 97 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :boxer-opengl 2 | (:use :common-lisp) 3 | (:use :boxer)) 4 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/perspective.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Boxer 2 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 3 | ;;;; 4 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 5 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 6 | ;;;; 7 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 8 | ;;;; 9 | ;;;; https://opensource.org/licenses/BSD-3-Clause 10 | ;;;; 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | (in-package :boxer-opengl) 17 | 18 | (defun create-perspective-matrix (wid hei) 19 | "Create an orthogonal projection matrix for use in our shaders with the given width and height." 20 | (3d-matrices:mperspective 45.0 (/ wid hei) 0.1 3000.0)) 21 | 22 | (defun rotations (view-matrix) 23 | (let ((x-rot 0) 24 | (y-rot 0) 25 | (z-rot 0)) 26 | (setf *box-depth-mult* 1) 27 | (sleep 1) (next-paint view-matrix x-rot y-rot z-rot) 28 | (loop for i 29 | from 0 to 100 30 | do (progn 31 | (decf z-rot 0.02) 32 | (incf x-rot 0.01) 33 | (incf *box-depth-mult* 0.12)) 34 | do (sleep 0.01) do (next-paint view-matrix x-rot y-rot z-rot)) 35 | (loop for i 36 | from 0 to 428 37 | do (decf z-rot 0.02) 38 | do (sleep 0.01) do (next-paint view-matrix x-rot y-rot z-rot)) 39 | (loop for i 40 | from 0 to 95 41 | do (progn 42 | (decf z-rot 0.02) 43 | (decf x-rot 0.01) 44 | (decf *box-depth-mult* 0.12)) 45 | do (sleep 0.01) do (next-paint view-matrix x-rot y-rot z-rot)) 46 | (setf *box-depth-mult* 1))) 47 | 48 | (defun flip-matrix-over-x-axis (matrix) 49 | "Returns a new matrix with the y value inverted over the x-axis." 50 | (let ((flip (3d-matrices:meye 4))) 51 | (setf (aref (3d-matrices:marr4 flip) 5) -1.0) 52 | (3d-matrices:m* matrix flip))) 53 | 54 | (defun next-paint (view-matrix x-rot y-rot z-rot) 55 | (let ((view-matrix (3d-matrices:meye 4))) 56 | (3d-matrices:nmtranslate view-matrix (3d-vectors:vec 0 0 -1900)) 57 | (setf view-matrix (flip-matrix-over-x-axis view-matrix)) 58 | 59 | (3d-matrices:nmrotate view-matrix 3d-vectors:+vx+ x-rot) 60 | (3d-matrices:nmrotate view-matrix 3d-vectors:+vy+ y-rot) 61 | (3d-matrices:nmrotate view-matrix 3d-vectors:+vz+ z-rot) 62 | 63 | (setf (boxer::boxgl-device-transform-matrix bw::*boxgl-device*) 64 | view-matrix)) 65 | (update-matrices-ubo bw::*boxgl-device*) 66 | (repaint-window)) 67 | 68 | (defun rotation-demo () 69 | ;; (bw::queue-event 'box::rotation-demo) 70 | (drawing-on-window (*boxer-pane*) 71 | (let* ((prev-proj (boxgl-device-projection-matrix bw::*boxgl-device*)) 72 | (prev-trans (boxgl-device-transform-matrix bw::*boxgl-device*)) 73 | (view-matrix (3d-matrices:meye 4)) 74 | (flip (3d-matrices:meye 4))) 75 | 76 | (setf (aref (3d-matrices:marr4 flip) 5) -1.0) 77 | 78 | (3d-matrices:nmtranslate view-matrix (3d-vectors:vec 0 0 -1900)) 79 | (setf view-matrix (3d-matrices:m* view-matrix flip)) 80 | 81 | (setf (boxgl-device-projection-matrix bw::*boxgl-device*) 82 | (create-perspective-matrix (viewport-width *boxer-pane*) (viewport-height *boxer-pane*)) 83 | 84 | (boxgl-device-transform-matrix bw::*boxgl-device*) 85 | view-matrix) 86 | 87 | (update-matrices-ubo bw::*boxgl-device*) 88 | (rotations view-matrix) 89 | 90 | (setf (boxgl-device-projection-matrix bw::*boxgl-device*) prev-proj 91 | (boxgl-device-transform-matrix bw::*boxgl-device*) prev-trans) 92 | (update-matrices-ubo bw::*boxgl-device*)))) 93 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-arcs.fs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout(origin_upper_left) in vec4 gl_FragCoord; 3 | 4 | in vec4 color; 5 | in vec4 circle_pos; 6 | in vec2 arc_sweeps; 7 | 8 | uniform mat4 model; 9 | 10 | layout (std140) uniform Matrices 11 | { 12 | mat4 projection; 13 | mat4 transform; 14 | vec2 u_resolution; 15 | }; 16 | 17 | out vec4 FragColor; 18 | 19 | float PI = 3.14; 20 | 21 | float figure_ground(in float fill, in bool flip) { 22 | if (flip) { 23 | return abs(fill - 1.0); 24 | } 25 | else { 26 | return fill; 27 | } 28 | } 29 | 30 | // https://stackoverflow.com/questions/6270785/how-to-determine-whether-a-point-x-y-is-contained-within-an-arc-section-of-a-c 31 | float arc(in vec2 center, in vec2 pos, in float radius, in float start, in float end, in float width) { 32 | float togo = 0.0; 33 | bool flip = false; 34 | 35 | float dist = distance(pos, center); 36 | togo = 1.0 - step(radius, dist); 37 | 38 | // if width is greater than zero, it's a hollow arc of width 39 | if (togo == 1.0 && width > 0.0) { 40 | togo = step(radius - width, dist); 41 | } 42 | 43 | float xt = pos.x - center.x; 44 | float yt = pos.y - center.y; 45 | float at = atan(yt, xt); 46 | 47 | if (yt < 0.0) { 48 | at = ((radians(180.0)) - abs(at)) + PI; 49 | } 50 | 51 | if (togo == 1.0) { 52 | if (start < end) { 53 | if (start < at && at < end) { 54 | togo = figure_ground(1.0, flip); // ok 55 | } 56 | else { 57 | togo = figure_ground(0.0, flip); 58 | } 59 | } 60 | else { 61 | if (at > start) { 62 | togo = figure_ground(1.0, flip); // ok 63 | } 64 | else if (at < end) { 65 | togo = figure_ground(1.0, flip); // ok 66 | } 67 | else { 68 | togo = figure_ground(0.0, flip); 69 | } 70 | } 71 | } 72 | 73 | return togo; 74 | } 75 | 76 | void main() { 77 | vec4 final_pos = transform * model * vec4(circle_pos.xy, 1.0, 1.0); 78 | float alpha = 0.0; 79 | float start = arc_sweeps.x; 80 | float end = arc_sweeps.y; 81 | 82 | alpha = arc(final_pos.xy , gl_FragCoord.xy, circle_pos.z, start, end, circle_pos.w); 83 | 84 | FragColor = vec4(color.xyz, color.w * alpha); 85 | } 86 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-arcs.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout (location = 0) in vec3 a_position; 3 | layout (location = 1) in vec4 a_color; 4 | layout (location = 2) in vec4 a_circle_pos; // cx, cy, radius, pen-width 5 | layout (location = 3) in vec2 a_arc_sweeps; // start-angle, end-angle 6 | 7 | out vec4 color; 8 | out vec4 circle_pos; 9 | out vec2 arc_sweeps; 10 | 11 | uniform mat4 model; 12 | 13 | layout (std140) uniform Matrices 14 | { 15 | mat4 projection; 16 | mat4 transform; 17 | vec2 u_resolution; 18 | }; 19 | 20 | void main() { 21 | color = a_color; 22 | circle_pos = a_circle_pos; 23 | arc_sweeps = a_arc_sweeps; 24 | gl_Position = projection * transform * model * vec4(a_position.xyz, 1.0); 25 | } 26 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-atlas-glyph.fs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | in vec2 TexCoords; 3 | in vec4 theColor; 4 | 5 | out vec4 color; 6 | 7 | uniform sampler2D text; 8 | 9 | void main() 10 | { 11 | vec4 sampled = vec4(1.0, 1.0, 1.0, texture(text, TexCoords).r); 12 | color = vec4(theColor.xyz, sampled.w); 13 | } 14 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-atlas-glyph.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout (location = 0) in vec3 aPos; 3 | layout (location = 1) in vec2 aTexCoord; 4 | layout (location = 2) in vec4 aColor; // We aren't using the alpha layer yet, but bringing it in 5 | // for future blending possibilities. 6 | 7 | out vec2 TexCoords; 8 | out vec4 theColor; 9 | 10 | uniform mat4 model; 11 | 12 | layout (std140) uniform Matrices 13 | { 14 | mat4 projection; 15 | mat4 transform; 16 | vec2 u_resolution; 17 | }; 18 | 19 | void main() 20 | { 21 | gl_Position = projection * transform * model * vec4(aPos.xyz, 1.0); 22 | TexCoords = aTexCoord; 23 | theColor = aColor; 24 | } 25 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-circle.fs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout(origin_upper_left) in vec4 gl_FragCoord; 3 | 4 | in vec4 color; 5 | in vec4 circle_pos; 6 | 7 | uniform mat4 model; 8 | 9 | layout (std140) uniform Matrices 10 | { 11 | mat4 projection; 12 | mat4 transform; 13 | vec2 u_resolution; 14 | }; 15 | 16 | out vec4 FragColor; 17 | 18 | float circle(in vec2 center, in vec2 pos, in float radius) { 19 | float dist = distance(pos, center); 20 | return 1.0 - step(radius, dist); 21 | } 22 | 23 | float hollow_circle(in vec2 center, in vec2 pos, in float radius, in float width) { 24 | float togo = 0.0; 25 | // First see if it's in the outermost circle 26 | float dist = distance(pos, center); 27 | togo = 1.0 - step(radius, dist); 28 | 29 | // Then if it's outside the innermost circle 30 | if (togo == 1.0) { 31 | togo = step(radius - width, dist); 32 | } 33 | 34 | return togo; 35 | } 36 | 37 | void main() { 38 | vec4 final_pos = transform * model * vec4(circle_pos.xy, 1.0, 1.0); 39 | float alpha = 0.0; 40 | 41 | if (circle_pos.w > 0.0) { 42 | alpha = hollow_circle(final_pos.xy , gl_FragCoord.xy, circle_pos.z, circle_pos.w); 43 | } 44 | else { 45 | alpha = circle(final_pos.xy , gl_FragCoord.xy, circle_pos.z); 46 | } 47 | 48 | FragColor = vec4(color.xyz, alpha * color.w); 49 | } 50 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-circle.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout (location = 0) in vec3 a_position; 3 | layout (location = 1) in vec4 a_color; 4 | layout (location = 2) in vec4 a_circle_pos; // cx, cy, radius, pen-width 5 | 6 | out vec4 color; 7 | out vec4 circle_pos; 8 | 9 | uniform mat4 model; 10 | 11 | layout (std140) uniform Matrices 12 | { 13 | mat4 projection; 14 | mat4 transform; 15 | vec2 u_resolution; 16 | }; 17 | 18 | void main() { 19 | color = a_color; 20 | circle_pos = a_circle_pos; 21 | gl_Position = projection * transform * model * vec4(a_position.xyz, 1.0); 22 | } 23 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-dashed-lines.fs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | 3 | flat in vec3 startPos; 4 | in vec3 vertPos; 5 | in vec4 theColor; 6 | out vec4 FragColor; 7 | 8 | uniform vec2 resolution; 9 | 10 | void main() 11 | { 12 | // https://stackoverflow.com/questions/52928678/dashed-line-in-opengl3 13 | float u_dashSize = 3.0; 14 | float u_gapSize = 3.0; 15 | 16 | vec2 dir = (vertPos.xy-startPos.xy) * resolution/2.0; 17 | float dist = length(dir); 18 | 19 | if (fract(dist / (u_dashSize + u_gapSize)) > u_dashSize/(u_dashSize + u_gapSize)) 20 | discard; 21 | 22 | FragColor = theColor; 23 | } 24 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-dashed-lines.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | //layout (location = 0) in vec3 aPos; 3 | layout (location = 0) in vec2 aPos; 4 | layout (location = 1) in vec4 aColor; 5 | 6 | out vec4 theColor; 7 | 8 | flat out vec3 startPos; 9 | out vec3 vertPos; 10 | 11 | uniform mat4 model; 12 | 13 | layout (std140) uniform Matrices 14 | { 15 | mat4 projection; 16 | mat4 transform; 17 | vec2 u_resolution; 18 | }; 19 | 20 | void main() 21 | { 22 | theColor = aColor; 23 | vec4 pos = projection * transform * model *vec4(aPos, 0.0, 1.0); 24 | gl_Position = pos; 25 | vertPos = pos.xyz / pos.w; 26 | startPos = vertPos; 27 | } 28 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-ellipse.fs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout(origin_upper_left) in vec4 gl_FragCoord; 3 | 4 | in vec4 color; 5 | in vec3 circle_pos; 6 | in vec2 ellipse_dims; 7 | 8 | uniform mat4 model; 9 | 10 | layout (std140) uniform Matrices 11 | { 12 | mat4 projection; 13 | mat4 transform; 14 | vec2 u_resolution; 15 | }; 16 | 17 | out vec4 FragColor; 18 | 19 | float ellipse(in vec2 center, in vec2 pos, in float width, in float height, in float size) { 20 | float togo = 0.0; 21 | 22 | float x2 = pow(pos.x - center.x, 2.); 23 | float y2 = pow(pos.y - center.y, 2.); 24 | float a2 = pow(width / 2., 2.); 25 | float b2 = pow(height / 2., 2.); 26 | float final = (x2 / a2) + (y2 / b2); 27 | 28 | if (final <= 1.0) { 29 | togo = 1.0; 30 | } 31 | 32 | if (size > 0.) { 33 | a2 = pow((width - size) / 2., 2.); 34 | b2 = pow((height - size) / 2., 2.); 35 | final = (x2 / a2) + (y2 / b2); 36 | if (final <= 1.0) { 37 | togo = 0.0; 38 | } 39 | } 40 | 41 | return togo; 42 | } 43 | 44 | void main() { 45 | vec4 final_pos = transform * model * vec4(circle_pos.xy, 1.0, 1.0); 46 | float alpha = 0.0; 47 | 48 | alpha = ellipse(final_pos.xy, gl_FragCoord.xy, ellipse_dims.x, ellipse_dims.y, circle_pos.z); 49 | 50 | FragColor = vec4(color.xyz, color.w * alpha); 51 | } 52 | 53 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-ellipse.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout (location = 0) in vec3 a_position; 3 | layout (location = 1) in vec4 a_color; 4 | layout (location = 2) in vec3 a_circle_pos; // cx, cy, pen-width 5 | layout (location = 3) in vec2 a_ellipse_dims; 6 | 7 | out vec4 color; 8 | out vec3 circle_pos; 9 | out vec2 ellipse_dims; 10 | 11 | uniform mat4 model; 12 | 13 | layout (std140) uniform Matrices 14 | { 15 | mat4 projection; 16 | mat4 transform; 17 | vec2 u_resolution; 18 | }; 19 | 20 | void main() { 21 | color = a_color; 22 | circle_pos = a_circle_pos; 23 | ellipse_dims = a_ellipse_dims; 24 | gl_Position = projection * transform * model * vec4(a_position.xyz, 1.0); 25 | } 26 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-freetype-glyph.fs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | in vec2 TexCoords; 3 | out vec4 color; 4 | 5 | uniform sampler2D text; 6 | uniform vec3 textColor; 7 | 8 | void main() 9 | { 10 | vec4 sampled = vec4(1.0, 1.0, 1.0, texture(text, TexCoords).r); 11 | color = vec4(textColor, sampled.w); 12 | } 13 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-freetype-glyph.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout (location = 0) in vec4 vertex; // 3 | out vec2 TexCoords; 4 | 5 | uniform mat4 model; 6 | 7 | layout (std140) uniform Matrices 8 | { 9 | mat4 projection; 10 | mat4 transform; 11 | vec2 u_resolution; 12 | 13 | }; 14 | 15 | void main() 16 | { 17 | gl_Position = projection * transform * model * vec4(vertex.xy, 0.0, 1.0); 18 | TexCoords = vertex.zw; 19 | } 20 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-lines.fs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | 3 | in vec4 theColor; 4 | out vec4 FragColor; 5 | 6 | void main() 7 | { 8 | FragColor = theColor; 9 | } 10 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-lines.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout (location = 0) in vec3 aPos; 3 | layout (location = 1) in vec4 aColor; 4 | 5 | out vec4 theColor; 6 | 7 | uniform mat4 model; 8 | 9 | layout (std140) uniform Matrices 10 | { 11 | mat4 projection; 12 | mat4 transform; 13 | vec2 u_resolution; 14 | }; 15 | 16 | void main() 17 | { 18 | theColor = aColor; 19 | gl_Position = projection * transform * model * vec4(aPos, 1.0); 20 | } 21 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-pixmap.fs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | out vec4 FragColor; 3 | 4 | in vec2 TexCoord; 5 | uniform sampler2D texture1; 6 | 7 | void main() 8 | { 9 | FragColor = texture(texture1, TexCoord); 10 | } 11 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-pixmap.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout (location = 0) in vec3 aPos; 3 | layout (location = 1) in vec2 aTexCoord; 4 | 5 | out vec2 TexCoord; 6 | 7 | uniform mat4 model; 8 | 9 | layout (std140) uniform Matrices 10 | { 11 | mat4 projection; 12 | mat4 transform; 13 | vec2 u_resolution; 14 | }; 15 | 16 | void main() 17 | { 18 | gl_Position = projection * transform * model * vec4(aPos, 1.0); 19 | TexCoord = vec2(aTexCoord.x, aTexCoord.y); 20 | } 21 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/shaders/boxgl-simple.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | layout (location = 0) in vec2 aPos; 3 | 4 | // A vertex shader for simpler lines that gets the color from the global uniform u_rgba 5 | // rather than 4 vertices passed in from a vao location. Useful for simple things like 6 | // drawing a box border where the entire thing will be the same basic color. 7 | // layout (location = 0) in vec3 aPos; 8 | 9 | out vec4 theColor; 10 | 11 | uniform mat4 model; 12 | 13 | layout (std140) uniform Matrices 14 | { 15 | mat4 projection; 16 | mat4 transform; 17 | vec2 u_resolution; 18 | }; 19 | 20 | void main() 21 | { 22 | theColor = vec4(0.0, 0.0, 0.0, 1.0); //u_rgba; 23 | gl_Position = projection * transform * model * vec4(aPos, 0.0, 1.0); 24 | } 25 | -------------------------------------------------------------------------------- /src/draw-low-opengl330/stencils.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Routines for using stencil buffers in Boxer. 17 | ;;;; 18 | (in-package :boxer-opengl) 19 | 20 | (defun clear-stencil-buffer () 21 | (gl:clear :stencil-buffer-bit)) 22 | 23 | (defun write-to-stencil (&key (clear-buffer t)) 24 | "Anything drawn here renders to the stencil buffer. In Boxer we're largely using this to stamp 25 | a rectangle for the inner portion of a box where the inside content will be renderered. The 26 | general usage is: 27 | 28 | (write-to-stencil) ;; without arguments clears the previous stencil buffer 29 | (draw-rectangle etc etc) 30 | (render-inside-stencil) 31 | (draw-box-contents) 32 | (ignore-stencil)" 33 | (when clear-buffer 34 | (gl:clear-stencil 0) 35 | (gl:stencil-mask #xFF) 36 | (gl:clear :stencil-buffer-bit)) 37 | (gl:stencil-func :always 1 #xFF) 38 | (gl:stencil-mask #xFF)) 39 | 40 | (defun render-inside-stencil () 41 | (gl:stencil-func :equal 1 #xFF) 42 | (gl:stencil-mask #x00)) 43 | 44 | (defun ignore-stencil () 45 | (gl:stencil-mask #x00) 46 | (gl:stencil-func :always 0 #xFF)) 47 | -------------------------------------------------------------------------------- /src/draw/mesh.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Platform independent GL Mesh 17 | ;;;; 18 | (in-package :boxer) 19 | -------------------------------------------------------------------------------- /src/draw/model.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Platform independent GL Model 17 | ;;;; 18 | 19 | (in-package :boxer) 20 | 21 | (defclass boxer-gl-model () 22 | ((cur-tick :initform 0 :accessor cur-tick 23 | :documentation "A value to store and compare against in the future to see if the structure 24 | this model draws has changed, and needs to be rebuffered. 25 | This doesn't necessarily have to be an integer, but it should a string 26 | or some lisp structure that can be compared using `equal`.") 27 | (needs-update :initform t :accessor needs-update))) 28 | 29 | (defmethod draw ((self boxer-gl-model)) 30 | nil) 31 | 32 | (defmethod reset-meshes ((self boxer-gl-model)) 33 | nil) 34 | -------------------------------------------------------------------------------- /src/editor-high/copy-paste-buffers.lisp: -------------------------------------------------------------------------------- 1 | ;;;; ;; -*- Mode:LISP;Syntax: Common-Lisp; Package:BOXER;-*- 2 | ;;;; 3 | ;;;; Boxer 4 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 5 | ;;;; 6 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 7 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 8 | ;;;; 9 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 10 | ;;;; 11 | ;;;; https://opensource.org/licenses/BSD-3-Clause 12 | ;;;; 13 | ;;;; 14 | ;;;; +-Data--+ 15 | ;;;; This file is part of the | BOXER | system 16 | ;;;; +-------+ 17 | ;;;; 18 | ;;;; 19 | ;;;; This continues utilities for various types Copy, Cut, Paste, Kill, Yank, Redo, 20 | ;;;; and Undo support. We want to continue supporting (for at least a while), emacs 21 | ;;;; Kill/Yank, OS style Cut/Copy/Paste, and some level of Undo/Redo support. 22 | ;;;; 23 | (in-package :boxer) 24 | 25 | ;; TODO Refactor contents of defboxer-command COM-ROTATE-KILL-BUFFER, so it's *kill-buffer* 26 | ;; manipulations are in this file. 27 | 28 | ;for control-y 29 | (DEFMACRO KILL-BUFFER-TOP () 30 | '(CAR *KILL-BUFFER*)) 31 | 32 | ;;; Used for modern OS style Cut/Copy/Paste 33 | (defvar *current-paste-item* nil 34 | "This is a single item, and is the same as member you push on the the *kill-buffer*. 35 | Other than only being a single item (rather than a list), this is different in that 36 | will only track full copy/paste operations on it. The kill ring tracks all sort 37 | of extra items such as single character deletes.") 38 | 39 | (defvar *kill-buffer-last-direction* nil) 40 | 41 | (defvar *kill-buffer-length* 8) 42 | 43 | (defvar *kill-buffer* (make-list *kill-buffer-length*)) 44 | 45 | (defvar *number-of-non-kill-commands-executed* 0) 46 | 47 | (defun kill-buffer-push (item direction &key (include-paste nil)) 48 | "Using :include-paste t, will also put the item on the paste clipboard in addition 49 | to the kill-buffer." 50 | (when (null item) 51 | (setq item :newline)) 52 | 53 | (if (<= *number-of-non-kill-commands-executed* 1) 54 | (if (eq direction *kill-buffer-last-direction*) 55 | (cond ((eq direction ':forward) 56 | (ensure-list item) 57 | (ensure-list (car *kill-buffer*)) 58 | (setf (car *kill-buffer*) 59 | (nconc (car *kill-buffer*) item))) 60 | ((eq direction ':backward) 61 | (ensure-list (car *kill-buffer*)) 62 | (setf (car *kill-buffer*) 63 | (cons item (car *kill-buffer*))))) 64 | (push item *kill-buffer*)) 65 | (push item *kill-buffer*)) 66 | 67 | (when include-paste 68 | (setf *current-paste-item* item)) 69 | ;; We don't want every deleted char to be in the clipboard, so adding to the 70 | ;; clipboard is now limited to the kill-region and copy-region commands 71 | ; (write-system-scrap (car *kill-buffer*)) 72 | (when (> (length *kill-buffer*) *kill-buffer-length*) 73 | (let ((objs-for-deallocation (car (nthcdr *kill-buffer-length* *kill-buffer*)))) 74 | (rplacd (nthcdr (1- *kill-buffer-length*) *kill-buffer*) nil) 75 | (queue-editor-objs-for-deallocation objs-for-deallocation))) 76 | (setq *kill-buffer-last-direction* direction) 77 | (setq *number-of-non-kill-commands-executed* 0) 78 | *kill-buffer*) 79 | -------------------------------------------------------------------------------- /src/editor-high/mode.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode:lisp;Syntax:Common-Lisp; Package:BOXER; Base:10.-*- 2 | 3 | #| 4 | 5 | 6 | $Header$ 7 | 8 | $Log$ 9 | 10 | Boxer 11 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 12 | 13 | Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 14 | used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 15 | 16 | Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 17 | 18 | https://opensource.org/licenses/BSD-3-Clause 19 | 20 | 21 | +-Data--+ 22 | This file is part of the | BOXER | system 23 | +-------+ 24 | 25 | 26 | This file contains utilies for creating and using Modes 27 | 28 | 29 | Modification History (most recent at top) 30 | 2/15/03 merged current LW and MCL files, no diffs, updated copyright 31 | 32 | |# 33 | 34 | (in-package :boxer) 35 | 36 | (defvar *active-modes* nil) 37 | 38 | (defun add-mode (mode) 39 | (unless (fast-memq mode *active-modes*) 40 | (push mode *active-modes*))) 41 | 42 | (defun remove-mode (mode) 43 | (setq *active-modes* (fast-delq mode *active-modes*))) 44 | 45 | (defun reset-modes () 46 | (setq *active-modes* nil)) 47 | 48 | 49 | ;; we need to record all existing comtabs in case of key name changes 50 | (defvar *existing-comtabs* nil) 51 | 52 | (defun make-comtab () 53 | (let ((new-comtab (make-hash-table))) 54 | (push new-comtab *existing-comtabs*) 55 | new-comtab)) 56 | 57 | (defun remove-comtab (comtab) 58 | (setq *existing-comtabs* (fast-delq comtab *existing-comtabs*))) 59 | 60 | 61 | (defclass basic-mode 62 | () 63 | ((name :initform nil :initarg :name) 64 | (comtab :initform (make-comtab)))) 65 | 66 | ;; more specific behaviors for other mode 67 | ;; for example, search mode should splice itself out of 68 | ;; the mode list if it the lookup is unsuccessful 69 | (defmethod lookup-mode-key ((self basic-mode) key-name) 70 | (gethash key-name (slot-value self 'comtab))) 71 | 72 | (defvar *global-top-level-mode* (make-instance 'basic-mode 73 | :name `global-top-level)) 74 | 75 | (defun record-vanilla-key (name fun) 76 | (let ((vanilla-comtab (when *global-top-level-mode* 77 | (slot-value *global-top-level-mode* 'comtab)))) 78 | (if (null vanilla-comtab) 79 | (warn "The Vanilla comtab is not defined yet") 80 | (setf (gethash name vanilla-comtab) 81 | (boxer-eval::encapsulate-key-function fun))))) 82 | 83 | (defmacro defboxer-mode-key (key-spec mode function) 84 | (let* ((shift-bits (if (listp key-spec) (cadr key-spec) 0)) 85 | (key-name 86 | (if (zerop shift-bits) 87 | key-spec 88 | (boxer::intern-in-bu-package 89 | (symbol-format nil "~A-~A" 90 | (get-shift-names shift-bits) 91 | (car key-spec)))))) 92 | `(if (not (typep ,mode 'basic-mode)) 93 | (error "~S is not a defined editor mode" ,mode) 94 | (setf (gethash ',key-name (slot-value ,mode 'comtab)) 95 | (boxer-eval::encapsulate-key-function ',function))))) 96 | 97 | (defun defboxer-mode-key-internal (key-name mode function) 98 | (setf (gethash key-name (slot-value mode 'comtab)) 99 | (boxer-eval::encapsulate-key-function function))) 100 | 101 | ;; loop through the list of current modes looking for key-name 102 | ;; return NIL 103 | 104 | (defun mode-key (key-name) 105 | (dolist (mode *active-modes*) 106 | (let ((key-binding (lookup-mode-key mode key-name))) 107 | (unless (null key-binding) (return key-binding))))) 108 | 109 | 110 | ;; keydefs should consist of keyspec, function pairs 111 | (defmacro defbasic-mode (mode-name &rest keydefs) 112 | (let ((mode-var (gensym))) 113 | `(progn 114 | (defclass ,mode-name 115 | (basic-mode) 116 | () 117 | ) 118 | (defvar ,mode-var (make-instance ',mode-name)) 119 | (defun ,mode-name () ,mode-var) 120 | . ,(with-collection 121 | (dolist (keyfunpair keydefs) 122 | (collect `(defboxer-mode-key ,(car keyfunpair) (,mode-name) 123 | ,(cadr keyfunpair)))))))) 124 | 125 | 126 | 127 | 128 | -------------------------------------------------------------------------------- /src/editor-high/mouse-tracking.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | ;;;; Vars and functions for keeping track of mouse location and movement 18 | ;;;; 19 | (in-package :boxer) 20 | 21 | ;; mouse motion 22 | (defvar *track-mouse-x* 0 23 | "Original x position in the window pane.") 24 | (defvar *track-mouse-y* 0 25 | "Original y position in the window pane.") 26 | 27 | (defvar *document-mouse-x* 0 28 | "Document x position based on transforming *track-mouse-x* with the current zoom and scroll values.") 29 | (defvar *document-mouse-y* 0 30 | "Document y position based on transforming *track-mouse-y* with the current zoom and scroll values.") 31 | 32 | (defvar *mouse-down-p* nil 33 | "If true, the primary mouse button is currently depressed (usually the left mouse button).") 34 | 35 | (defun boxer-pane-mouse-down? () 36 | *mouse-down-p*) 37 | 38 | (defun boxer-pane-mouse-position () 39 | ;; must allow track mouse handler in the interface(boxer) process to run 40 | #+lispworks (mp::process-allow-scheduling) 41 | ;; (values *track-mouse-x* *track-mouse-y*) 42 | (values *document-mouse-x* *document-mouse-y*) 43 | ) 44 | 45 | (defmacro with-mouse-tracking (((original-x-variable original-x-value) 46 | (original-y-variable original-y-value) 47 | &key 48 | event-skip timeout action 49 | (body-function-name (gensym))) 50 | &body body) 51 | (declare (ignore event-skip timeout)) 52 | `(let ((,original-x-variable ,original-x-value) 53 | (,original-y-variable ,original-y-value) 54 | (moved-p nil)) 55 | (flet ((,body-function-name () . ,body)) 56 | (with-mouse-cursor (,action) 57 | (do ((last-mouse-x -1) (last-mouse-y -1)) 58 | ((not (boxer-pane-mouse-down?)) 59 | (values ,original-x-variable ,original-y-variable moved-p)) 60 | (multiple-value-setq (,original-x-variable ,original-y-variable) 61 | (boxer-pane-mouse-position)) 62 | (unless moved-p 63 | (unless (and (= ,original-x-variable ,original-x-value) 64 | (= ,original-y-variable ,original-y-value)) 65 | (setq moved-p t))) 66 | (unless (and (= ,original-x-variable last-mouse-x) 67 | (= ,original-y-variable last-mouse-y)) 68 | (setq last-mouse-x ,original-x-variable last-mouse-y ,original-y-variable) 69 | (,body-function-name))))))) 70 | -------------------------------------------------------------------------------- /src/evaluator/eval-eval.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Syntax: Common-Lisp ; Base: 10; Package: EVAL -*- 2 | 3 | #| 4 | 5 | 6 | $Header: eval-eval.lisp,v 1.0 90/01/24 22:11:14 boxer Exp $ 7 | 8 | $Log: eval-eval.lisp,v $ 9 | ;;;Revision 1.0 90/01/24 22:11:14 boxer 10 | ;;;Initial revision 11 | ;;; 12 | 13 | Boxer 14 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 15 | 16 | Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 17 | used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 18 | 19 | Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 20 | 21 | https://opensource.org/licenses/BSD-3-Clause 22 | 23 | 24 | +-------+ 25 | This file is part of the | Boxer | System 26 | +-Data--+ 27 | 28 | 29 | 30 | Modification History (most recent at top) 31 | 32 | 2/15/03 merged current LW and MCL files, no diffs, updated copyright 33 | |# 34 | 35 | ;;; 36 | 37 | (in-package :boxer-eval) 38 | 39 | (defun boxer-eval (iline &key (process-state nil)) 40 | (evaluator-body iline process-state)) 41 | -------------------------------------------------------------------------------- /src/evaluator/fdeval.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode:LISP;Syntax: Common-Lisp; Package:BOXER;-*- 2 | #| 3 | 4 | 5 | $Header$ 6 | 7 | $Log$ 8 | 9 | Boxer 10 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 11 | 12 | Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 13 | used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 14 | 15 | Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 16 | 17 | https://opensource.org/licenses/BSD-3-Clause 18 | 19 | 20 | +-Data--+ 21 | This file is part of the | BOXER | system 22 | +-------+ 23 | 24 | 25 | 26 | Foreign data in the evaluator 27 | 28 | Interface to foreign data types in the evaluator consists of: 29 | 1) classes of objects built from the FOREIGN-DATA class 30 | 2) The following Methods for those classes: 31 | foreign-data-set ; used by CHANGE (default=error) 32 | virtual-copy-foreign-data ; used by virtual-copy (default=error) 33 | make-editor-box-from-foreign-data ; used by the printer (default=error) 34 | port-to-foreign-data ; used by port-to (default OK) 35 | lookup-variable-in-foreign-data ; used by TELL (default OK) 36 | 37 | 38 | Modification History (most recent at top) 39 | 2/11/03 merged current LW and MCL files 40 | 41 | 42 | |# 43 | 44 | (in-package :boxer) 45 | 46 | (defclass foreign-data 47 | () 48 | () 49 | (:documentation "A Mixin for Foreign data types inthe boxer evaluator")) 50 | 51 | ;; called from CHANGE. will be standard boxer data, possibly a 52 | ;; port-to other foreign-data 53 | (defmethod foreign-data-set ((fd foreign-data) new-value) 54 | (declare (ignore new-value)) 55 | (boxer-eval::primitive-signal-error "No set method defined for " 56 | (type-of fd) 57 | " type of foreign data")) 58 | 59 | ;; converts foreign data to a boxer object 60 | (defmethod virtual-copy-foreign-data ((fd foreign-data)) 61 | (boxer-eval::primitive-signal-error "No Virtual Copy method defined for " 62 | (type-of fd) 63 | " type of foreign data")) 64 | 65 | ;; how to convert foreign data back to boxer editor structure 66 | (defmethod make-editor-box-from-foreign-data ((fd foreign-data)) 67 | (error "No print method defined for ~A" fd)) 68 | 69 | ;; a hook for any special handling during port-to. Default just makes a port 70 | (defmethod port-to-foreign-data ((fd foreign-data)) 71 | (make-virtual-port :target fd)) 72 | 73 | 74 | ;; if TELL is passed some foreign data, it will call this generic function 75 | (defmethod lookup-variable-in-foreign-data ((fd foreign-data) var) 76 | (declare (ignore var)) 77 | nil) 78 | 79 | (defmethod boxer-eval::boxer-symeval-dots-list-fd (error-symbol 80 | (fd foreign-data) list) 81 | (declare (ignore list)) 82 | (boxer-eval::signal-error :dots-variable-lookup "in" error-symbol)) 83 | 84 | 85 | 86 | 87 | 88 | -------------------------------------------------------------------------------- /src/evalutils/eval-utils.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Syntax: Common-Lisp; Base: 10; Package: EVAL -*- 2 | 3 | #| 4 | 5 | 6 | $Header: eval-utils.lisp,v 1.0 90/01/24 22:11:18 boxer Exp $ 7 | 8 | $Log: eval-utils.lisp,v $ 9 | ;;;Revision 1.0 90/01/24 22:11:18 boxer 10 | ;;;Initial revision 11 | ;;; 12 | 13 | Boxer 14 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 15 | 16 | Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 17 | used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 18 | 19 | Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 20 | 21 | https://opensource.org/licenses/BSD-3-Clause 22 | 23 | 24 | +-Data--+ 25 | This file is part of the | BOXER | system 26 | +-------+ 27 | 28 | 29 | The Explicit Control Evaluator 30 | 31 | Modification History (most recent at top) 32 | 33 | 2/15/03 merged current LW and MCL files, no diffs, updated copyright 34 | 35 | |# 36 | 37 | (in-package :boxer-eval) 38 | 39 | ;;; 40 | ;;; Triggers 41 | ;;; 42 | 43 | ;;; Triggers are lists to be evaluated at various times. Sometimes 44 | ;;; they are inside primitives, and sometimes they are inside editor 45 | ;;; functions. Of course, sometimes editor primitives are called 46 | ;;; inside the evaluator. 47 | 48 | ;;; The following function sets a variable to the list to be run. 49 | ;;; The evaluator checks the list after calling an sfun in case 50 | ;;; something that a primitive did caused it to be set. 51 | ;;; Similarly, the two handle-boxer-key and handle-boxer-mouse-click 52 | ;;; functions check this variable in case an editor function set it. 53 | 54 | 55 | #| ;; this loses when a box has both exit and modified triggers 56 | (defun arrange-for-list-to-be-run (list) 57 | (when (not (null *trigger-list-to-run*)) 58 | (error "A trigger was tripped when an unprocessed trigger was pending: ~S, ~S" 59 | *trigger-list-to-run* list)) 60 | (setq *trigger-list-to-run* list)) 61 | |# 62 | 63 | (defun arrange-for-list-to-be-run (list) 64 | (if (null *trigger-list-to-run*) 65 | (setq *trigger-list-to-run* list) 66 | (setq *trigger-list-to-run* (append *trigger-list-to-run* list)))) 67 | 68 | 69 | ;;this function is kind of crocked up. the value stuff is all wrong. 70 | (defun handle-trigger-list-in-eval (current-value rest-of-line) 71 | (declare (ignore rest-of-line)) 72 | (case *sfun-continuation* 73 | (*std-sfun-continuation* 74 | (prog1 75 | (make-interpreted-procedure-from-list 76 | (list *trigger-list-to-run* 77 | (list (if (eq current-value *novalue*) 78 | '%novalue-internal 79 | current-value)))) 80 | (setq *sfun-continuation* '*ufuncall-sfun-result-sfun-continuation*) 81 | (setq *trigger-list-to-run* nil))) 82 | (*eval-loop-sfun-continuation* 83 | (error "Can't handle the trigger and CONTINUE at the same time.")) 84 | (*macroexpand-sfun-continuation* 85 | (make-interpreted-procedure-from-list 86 | (append *trigger-list-to-run* 87 | (make-doit-vc-from-list 88 | (interpreted-boxer-function-text current-value))))) 89 | (*ufuncall-sfun-result-sfun-continuation* 90 | (make-interpreted-procedure-from-list 91 | (append (list *trigger-list-to-run*) 92 | (interpreted-boxer-function-text current-value)))) 93 | (*run-list-sfun-continuation* 94 | (error "Can't handle a trigger and *run-list-sfun-continuation*")) 95 | (otherwise 96 | (error "Unknown sfun continuation type")))) 97 | 98 | (defun make-doit-vc-from-list (list) 99 | (boxer::make-vc 100 | (list 101 | (boxer::make-evrow-from-pointers 102 | (mapcar #'boxer::make-pointer list))) 103 | 'boxer::doit-box)) 104 | 105 | 106 | ;;; 107 | ;;; Special Tokens 108 | ;;; 109 | 110 | (defun make-squid (item) 111 | (let ((array (make-array 3))) 112 | (setf (svref& array 0) 'special-eval-token) 113 | (setf (svref& array 1) 'self-quoting-internal-datum) 114 | (setf (svref& array 2) item) 115 | array)) 116 | -------------------------------------------------------------------------------- /src/filesystem/boxer-document-format.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | ;;;; Code for reading and writing the new .boxer document format, which is encoded in a zip file 18 | ;;;; .docx, .pages, .odt and other office/document formats. 19 | 20 | (in-package :boxer) 21 | 22 | (defun get-default-template () 23 | "We have this special function to generate our own template rather than use the default, because when we deliver 24 | binaries on LispWorks, the system temporary directory from the image can get cached, and the folders for temporary 25 | directory locations are always different between instances of users/machines. Using this forces a lookup of the 26 | current temporary directory, rather than reusing the temporary directory root from the machine that the macOS/platform 27 | Application was built on." 28 | (format nil "~A%" (pathname (cl-fad::get-default-temporary-directory)))) 29 | 30 | (defun save-box-to-boxer-document-format-zipped (box filename) 31 | "Saves a box to the zipped boxer document format. 32 | We are associating this format with the .boxer file extension. 33 | 34 | The zip manifest file structure looks as follows: 35 | + ./ 36 | + boxer/ 37 | - document.box 38 | " 39 | ;; 1. Create a zip manifest 40 | (zip:with-output-to-zipfile (zf filename :if-exists :supersede) 41 | ;; 2. Stream data to a temp file 42 | (cl-fad:with-open-temporary-file (temp-stream :direction :io :element-type '(unsigned-byte 8) 43 | :template (get-default-template)) 44 | (dump-top-level-box box nil temp-stream) 45 | (close temp-stream) 46 | ;; 3. Add that temp-file as a zipfile entry 47 | ;; It would be nice to do this with a bi-direction stream or something, rather than a physical 48 | ;; intermediate file. 49 | (with-open-file (file-stream (pathname temp-stream) :direction :input :element-type '(unsigned-byte 8)) 50 | (zip:write-zipentry zf "boxer/document.box" file-stream))))) 51 | 52 | (defun load-boxer-document-zipped (filename) 53 | "Given the filename of a .boxer document in zipped format with an binary box inside at 54 | boxer/document.box, open the file and return the box CLOS object for use." 55 | (zip:with-zipfile (zf filename) 56 | (let ((box-file-entry (zip:get-zipfile-entry "boxer/document.box" zf))) 57 | (cl-fad:with-open-temporary-file (temp-stream :direction :io :element-type '(unsigned-byte 8) 58 | :template (get-default-template)) 59 | (zip:zipfile-entry-contents box-file-entry temp-stream) 60 | (close temp-stream) 61 | (load-binary-box-internal (pathname temp-stream)))))) 62 | -------------------------------------------------------------------------------- /src/filesystem/datasources/http-url.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode:LISP; Syntax:Common-Lisp; Package:BOXNET; -*- 2 | #| 3 | 4 | Boxer 5 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 6 | 7 | Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 8 | used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 9 | 10 | Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 11 | 12 | https://opensource.org/licenses/BSD-3-Clause 13 | 14 | 15 | +-Data--+ 16 | This file is part of the | BOXER | system 17 | +-------+ 18 | 19 | 20 | 21 | This file contains boxer http related functions & methods 22 | 23 | 24 | Modification History (most recent at top) 25 | 26 | 2/16/03 copied into unified (LW & MCL) source 27 | 8/07/02 added url-values 28 | 4/04/02 started http.lisp file 29 | 30 | |# 31 | 32 | (in-package :boxnet) 33 | 34 | ;;; http-url methods for 35 | ;;; + INITIALIZE-INSTANCE 36 | ;;; + COPY-URL 37 | ;;; + FILL-BOX-USING-URL is the main interface function 38 | ;;; + DUMP-PLIST-INTERNAL and DUMP-PLIST-LENGTH for file system interface 39 | ;;; 40 | 41 | (defclass http-url 42 | (net-url) 43 | (;; used by boxer 44 | (doc-type :initform ':text :accessor http-url-doc-type :initarg :doc-type))) 45 | 46 | (defclass https-url (http-url) ()) 47 | 48 | (defvar *default-url-port* 80) 49 | 50 | (defmethod initialize-instance ((url http-url) &rest initargs) 51 | (call-next-method) 52 | ;; now set up default values for user, port and password if they 53 | ;; haven't been filled by the net-url method 54 | (when (null (slot-value url 'port)) 55 | (setf (slot-value url 'port) *default-url-port*)) 56 | (let* ((path (slot-value url 'path)) 57 | (suffix (pathname-type path)) 58 | (supplied-doc-type (getf initargs :doc-type))) 59 | (if (not (null supplied-doc-type)) 60 | ;; if the doc-type is in the initargs, go with it (the slot will 61 | ;; already have been set by shared-initialize in an earlier method) 62 | (setf (slot-value url 'doc-type) supplied-doc-type) 63 | (setf (slot-value url 'doc-type) 64 | (cond ((null suffix) ':text) 65 | ((string-equal suffix "box") ':box) 66 | ;; add any other recognized suffixes here 67 | ((or (string-equal suffix "txt") (string-equal suffix "text")) 68 | ':text) 69 | (t ':binary)))))) 70 | 71 | (defmethod copy-url ((url http-url)) 72 | (let ((new (call-next-method))) 73 | (setf (slot-value new 'doc-type) (slot-value url 'doc-type)) 74 | new)) 75 | 76 | (defmethod url-values ((url http-url)) 77 | (let ((dt (slot-value url 'doc-type))) 78 | (cond ((null dt) 79 | (call-next-method)) 80 | (t (append (call-next-method) (list "Document-Type" dt)))))) 81 | 82 | ;; we might want to set up some defaults here (like index.html, or .box) 83 | (defmethod decode-net-url-for-url ((url http-url) string) 84 | (decode-net-url string t)) 85 | 86 | ;;; http input streams 87 | 88 | (defmethod fill-box-using-url ((url http-url) box) 89 | (multiple-value-bind 90 | (stream status-code headers) 91 | (drakma:http-request (urlstring url) :want-stream t) 92 | (cond ((and (eq status-code 200) 93 | (eq :box (slot-value url 'doc-type))) 94 | (let ((b (let ((boxer::*file-system-verbosity* T) 95 | (boxer::*FILE-STATUS-LINE-UPDATE-FUNCTION* 'print-ftp-read-status)) 96 | (boxer::load-binary-box-from-stream-internal stream)))) 97 | (initialize-box-from-net-box box b) 98 | (set-url-flags box))) 99 | ((eq status-code 200) ; :binary :text 100 | ;; sgithens 2020-10-21 We should be handling this the same way opening a local file 101 | ;; does with other file types... 102 | (save-net-data stream box :binary)) 103 | (t 104 | (surf-message "HTTP Error detected ~A ~A" status-code "Http Error") 105 | (boxer-eval::primitive-signal-error :http status-code "Http Error")))) 106 | (boxer::status-line-undisplay 'surf-message)) 107 | -------------------------------------------------------------------------------- /src/filesystem/datasources/local-url.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | 18 | (in-package :boxnet) 19 | 20 | ;; this is for files on the local host, that is, files which can be accessed 21 | ;; with the usual file access mechanisms like open-file, so NFS (or Appleshare?) 22 | ;;mounted files are included in this category since their access is transparent 23 | 24 | (defclass local-url 25 | (url) 26 | ((pathname :initform nil :accessor local-url-pathname) 27 | (host-type :initform nil :accessor local-url-host-type :initarg :host-type))) 28 | 29 | ;;; Local Files 30 | 31 | (defmethod initialize-instance ((url local-url) &rest initargs) 32 | (call-next-method) ;; this initializes scheme-string 33 | (setf (slot-value url 'pathname) 34 | (let ((slash-pos (search "//" (slot-value url 'scheme-string)))) 35 | (if (and slash-pos (zerop slash-pos)) 36 | (subseq (slot-value url 'scheme-string) 2) 37 | (slot-value url 'scheme-string)))) 38 | (setf (slot-value url 'host-type) 39 | (or (getf initargs :host-type) (machine-type)))) 40 | 41 | (defmethod copy-url ((url local-url)) 42 | (let ((new (call-next-method))) 43 | (setf (slot-value new 'pathname) (slot-value url 'pathname)) 44 | new)) 45 | 46 | (defmethod fill-box-using-url ((url local-url) box) 47 | (let ((filebox (boxer::read-internal-1 (slot-value url 'pathname)))) 48 | (initialize-box-from-net-box box filebox) 49 | ;; now do the box/file bookkeeping, 50 | ;; NOTE: It has to be here AFTER the initialize-box-from-box 51 | (when (box? box) 52 | ;(boxnet::read-box-postamble box) ;(part of the Boxer Server) no longer used 53 | (boxer::mark-box-as-file box (slot-value url 'pathname)) 54 | (boxer::mark-file-box-clean box)) 55 | ;; keep track of the file properties so that we can check 56 | (boxer::record-boxer-file-properties 57 | (slot-value url 'pathname) 58 | (file-write-date (slot-value url 'pathname)) 59 | (file-author (slot-value url 'pathname)) box) 60 | box)) 61 | 62 | (defmethod dump-plist-internal ((self local-url) stream) 63 | (call-next-method) 64 | (dump-boxer-thing :host-type stream) 65 | (dump-boxer-thing (slot-value self 'host-type) stream)) 66 | 67 | (defmethod dump-plist-length ((self local-url)) 68 | (+& (call-next-method) 2)) 69 | -------------------------------------------------------------------------------- /src/filesystem/datasources/url.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | 18 | (in-package :boxnet) 19 | 20 | ;; generic 21 | (defclass url 22 | () 23 | ((scheme-string :initform nil :accessor scheme-string :initarg :scheme-string)) 24 | ;; (:abstract-class t) 25 | (:documentation "Bare Bones url class-not meant to be instantiated")) 26 | 27 | 28 | 29 | ;;; Basic required methods for all URL's 30 | ;;; 31 | ;;; ALL URL's should explicitly support the following methods: 32 | ;;; + INITIALIZE-INSTANCE 33 | ;;; + COPY-URL 34 | ;;; + FILL-BOX-USING-URL is the main interface function 35 | ;;; + DUMP-PLIST-INTERNAL and DUMP-PLIST-LENGTH for file system interface 36 | ;;; 37 | 38 | ;;; More specific methods should use the URL parsing rules for each 39 | ;;; particular URL as defined in RFC 1738 on the scheme-string slot 40 | (defmethod initialize-instance ((url url) &rest initargs) 41 | (shared-initialize url T) 42 | (setf (slot-value url 'scheme-string) (getf initargs :scheme-string))) 43 | 44 | ;; this should be faster since we just copy slots instead of decoding 45 | ;; the scheme-string again 46 | (defmethod copy-url ((url url)) 47 | ;(make-instance (class-of url) :scheme-string (slot-value url 'scheme-string)) 48 | (let ((new (allocate-instance (class-of url)))) 49 | (setf (slot-value new 'scheme-string) (slot-value url 'scheme-string)) 50 | new)) 51 | 52 | ;; signals error by default, more specific classes of url's actually do the work 53 | (defmethod fill-box-using-url ((url url) box) 54 | (declare (ignore box)) 55 | (error "Don't know how to fill box from ~A " url)) 56 | 57 | (defmethod dump-url ((url url) stream) 58 | ;; fake a dump list 59 | (dump-list-preamble (dump-plist-length url) stream) 60 | (dump-plist-internal url stream)) 61 | 62 | ;; this is just like other boxer object dump methods 63 | ;; with more specialized versions for particular url's 64 | ;; note that the other methods should (call-next-method) first 65 | ;; so that the type symbol comes up first 66 | (defmethod dump-plist-internal ((self url) stream) 67 | (dump-boxer-thing (type-of self) stream) 68 | (dump-boxer-thing :scheme-string stream) 69 | (dump-boxer-thing (slot-value self 'scheme-string) stream)) 70 | 71 | (defmethod dump-plist-length ((self url)) 3) 72 | 73 | (defmethod file-status-line-string ((self url)) 74 | (if (typep self 'local-url) :local :network)) 75 | 76 | ;; loading 77 | (defun load-url (url-list) 78 | (apply #'make-instance (car url-list) (cdr url-list))) 79 | 80 | (defmethod protocol-string ((url url)) 81 | (let* ((rawtype (string (type-of url))) 82 | (pos (search "-URL" rawtype))) 83 | (if (null pos) rawtype (subseq rawtype 0 pos)))) 84 | 85 | (defmethod urlstring ((url url)) 86 | (concatenate 'string (protocol-string url) ":" 87 | (slot-value url 'scheme-string))) 88 | 89 | 90 | ;;; These are the main hooks into the rest of boxer. 91 | 92 | (defun read-internal-url (url-string) 93 | (let ((box (make-box-from-url url-string))) 94 | ;(boxer::foo) 95 | (fill-box-from-url box) 96 | box)) 97 | 98 | (defun read-only-internal (path) 99 | (let* ((url-string (concatenate 'string "local://" path)) 100 | (box (make-box-from-url url-string))) 101 | (fill-box-from-url box) 102 | ;; make sure it is Read Only 103 | (setf (read-only-box? box) t) 104 | box)) 105 | -------------------------------------------------------------------------------- /src/filesystem/formats.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | 18 | (in-package :boxer) 19 | 20 | ;;;; special file readers 21 | ;; these can be platform specific (i.e. :pict for the mac) or 22 | ;; they can work across platforms for defined standards like GIF 23 | ;; EVERYTHING must support the types :boxer and :text 24 | 25 | ;; this should eventually use /etc/magic 26 | (defun file-type (filename) 27 | "Returns the symbol for the file type that determines which reader/write will be used by 28 | box" 29 | (cond ((and (probe-file filename) (boxer-file-contents? filename)) 30 | :application/box) 31 | ((equal (pathname-type filename) "box") 32 | :application/box) 33 | ((equal (pathname-type filename) "boxer") 34 | :application/boxer.document) 35 | (t 36 | :text) 37 | )) 38 | 39 | (defvar *error-on-unknown-file-type* nil) 40 | 41 | (defvar *special-file-readers* nil) 42 | 43 | ;; TYPE is a keyword returned by the file-type function 44 | ;; FUNCTION is a function that takes 1 arg, a filename, and should return a box 45 | (defmacro deffile-type-reader (type function) 46 | `(progn 47 | (unless (fast-memq ',type *special-file-readers*) 48 | (push ',type *special-file-readers*)) 49 | (setf (get ',type 'file-type-reader-function) ',function))) 50 | 51 | (defun get-special-file-reader (type) (get type 'file-type-reader-function)) 52 | 53 | ;; the basic file readers... 54 | (deffile-type-reader :boxer load-binary-box-internal) ;; historical boxes may need this 55 | (deffile-type-reader :application/box load-binary-box-internal) 56 | (deffile-type-reader :application/boxer.document load-boxer-document-zipped) 57 | 58 | (deffile-type-reader :text read-text-file-internal) ;; historical boxes may need this 59 | (deffile-type-reader :text/plain read-text-file-internal) 60 | 61 | 62 | ;;;; special file writers 63 | 64 | (defvar *special-file-writers* nil) 65 | 66 | ;; TYPE is a keyword returned by the file-type function 67 | ;; FUNCTION is a function that takes 1 arg, a filename, and should return a box 68 | (defmacro deffile-type-writer (type function) 69 | `(progn 70 | (unless (fast-memq ',type *special-file-writers*) 71 | (push ',type *special-file-writers*)) 72 | (setf (get ',type 'file-type-writer-function) ',function))) 73 | 74 | (defun get-special-file-writer (type) (get type 'file-type-writer-function)) 75 | 76 | ;; the basic file writers... 77 | (deffile-type-writer :boxer load-binary-box-internal) 78 | (deffile-type-writer :application/box load-binary-box-internal) 79 | 80 | (deffile-type-writer :text read-text-file-internal) 81 | (deffile-type-writer :text/plain read-text-file-internal) 82 | 83 | (defun untitled-filename (directory) 84 | "Creates an untitled filename used to save a new box file. Checks to make sure 85 | it doens't exist already." 86 | (do ((i 1 (1+ i)) 87 | (filename nil) 88 | (togo nil)) 89 | ((not (null togo)) 90 | togo) 91 | (cond ((= i 1) 92 | (setf filename "Untitled.box")) 93 | (t 94 | (setf filename (format nil "Untitled ~A.box" i)))) 95 | (unless (probe-file (cl-fad:merge-pathnames-as-file directory filename)) 96 | (setf togo (cl-fad:merge-pathnames-as-file directory filename))))) 97 | -------------------------------------------------------------------------------- /src/grfdefs/graphics-clear.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +-Data--+ 14 | ;;;; This file is part of the | BOXER | system 15 | ;;;; +-------+ 16 | ;;;; 17 | ;;;; This file contains methods for clear-box and clearscreen. Initially this was refactored from grfdfs.lisp because 18 | ;;;; of compile time dependencies between that file and gdispl.lisp. This functionality has been placed after both of 19 | ;;;; them. 20 | ;;;; 21 | 22 | (in-package :boxer) 23 | 24 | (defmethod clear-box ((self box) &key (bitmap-p t) (graphics-list-p t)) 25 | (let ((graphics-sheet (slot-value self 'graphics-info))) 26 | (unless (null graphics-sheet) 27 | (let ((graphics-list (graphics-sheet-graphics-list graphics-sheet)) 28 | (bit-array (graphics-sheet-bit-array graphics-sheet)) 29 | (gswid (graphics-sheet-draw-wid graphics-sheet)) 30 | (gshei (graphics-sheet-draw-hei graphics-sheet)) 31 | (bg (graphics-sheet-background graphics-sheet))) 32 | ;; first, clear the storage for each of the drawing surfaces 33 | (when (and graphics-list-p (not (null graphics-list))) 34 | (clear-graphics-list graphics-list)) 35 | (when bitmap-p 36 | (cond ((not (null bit-array)) 37 | (clear-offscreen-bitmap bit-array (or bg *background-color*))) 38 | ;; ((color? bg) 39 | ;; (setf (graphics-sheet-background graphics-sheet) nil)) 40 | ;; tiling pattern code here 41 | )) 42 | ;; Clear any framebuffers if present 43 | (clear-graphics-canvas self))))) 44 | 45 | (defmethod clearscreen ((self box) 46 | &optional surface) 47 | (cond ((eq surface :background) 48 | (clear-box self :bitmap-p t :graphics-list-p nil)) 49 | ((eq surface :foreground) 50 | (clear-box self :bitmap-p nil :graphics-list-p t)) 51 | ((eq surface :none) 52 | (clear-box self :bitmap-p nil :graphics-list-p nil)) 53 | (t (clear-box self)))) 54 | -------------------------------------------------------------------------------- /src/impexp/boxer-sunrise-html-export.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem "boxer-sunrise-html-export" 2 | :version "3.4.23" 3 | :author "Steven Githens" 4 | :license "BSD-3-Clause" 5 | :depends-on ("boxer-sunrise" 6 | :cffi 7 | :html-entities 8 | :qbase64 9 | :zpng 10 | ) 11 | :components ((:file "full-html-export")) 12 | :description "HTML Export system. In it's own system due to a large number of dependencies.") 13 | -------------------------------------------------------------------------------- /src/opengl-lw-8/compile.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/61/LISPopengl/RCS/compile.lisp,v 1.8.14.1 2021/07/12 15:10:01 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | (in-package "CL-USER") 6 | 7 | (load (current-pathname "defsys")) 8 | 9 | (compile-system "OPENGL" :load t) 10 | 11 | -------------------------------------------------------------------------------- /src/opengl-lw-8/defsys.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/61/LISPopengl/RCS/defsys.lisp,v 1.17.5.1 2021/07/12 15:10:01 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | (in-package "USER") 6 | 7 | (pushnew :use-fli-gl-vector sys::*features*) 8 | 9 | (defsystem "OPENGL" 10 | (:optimize ((debug 3) (safety 3))) 11 | :members ( "pkg" 12 | "constants" 13 | "types" 14 | "vectors" 15 | "fns" 16 | ("xfns" :features (or :ffi-x11 :gtk)) 17 | ("win32" :features :win32) 18 | "ufns" 19 | "capi" 20 | ("gtk-lib" :features :gtk) 21 | ("xm-lib" :features :ffi-x11) 22 | ("msw-lib" :features :win32) 23 | ("cocoa" :features :cocoa) 24 | 25 | "loader" 26 | ) 27 | :rules ((:in-order-to :load :all 28 | (:requires (:load :serial))) 29 | (:in-order-to :compile :all 30 | (:caused-by (:compile :previous)) 31 | (:requires (:load :serial)))) 32 | ) 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/3d-text.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/9/LISPopengl-examples/RCS/3d-text.lisp,v 1.7.2.2 2021/11/22 20:40:42 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | (in-package "CL-USER") 6 | 7 | (defun set-up-gl-fonts (pane obj) 8 | #-mswindows (declare (ignore pane obj)) 9 | #+mswindows 10 | (when (name obj) 11 | (unless (assoc :font (extra-display-lists obj)) 12 | (push (list :font 13 | (win32::wgl-use-font pane 14 | :start 0 15 | :count 256 16 | :outlinep t) 17 | 256) 18 | (extra-display-lists obj))))) 19 | 20 | (defmacro with-3d-text-state-saved (&body body) 21 | `(opengl:with-matrix-pushed 22 | #+mswindows 23 | (opengl:gl-push-attrib opengl:*gl-all-attrib-bits*) 24 | ,@body 25 | #+mswindows 26 | (opengl:gl-pop-attrib))) 27 | 28 | #+ftgl 29 | (defvar *ftgl-font-file* "/usr/share/fonts/paratype-pt-sans/PTN57F.ttf") 30 | 31 | (defun draw-3d-text (obj text) 32 | #+mswindows 33 | (let* ((base (second (assoc :font (extra-display-lists obj))))) 34 | ;; Set up for a string-drawing display list call. 35 | (opengl:gl-list-base base) 36 | ;; Draw a string using font display lists. 37 | (fli:with-foreign-string (ptr elts bytes 38 | :external-format win32:*multibyte-code-page-ef* 39 | :null-terminated-p nil) 40 | text 41 | (declare (ignore bytes)) 42 | (opengl:gl-call-lists elts 43 | opengl:*gl-unsigned-byte* 44 | ptr))) 45 | #+ftgl 46 | (let ((font (ftgl:ftgl-create-extrude-font *ftgl-font-file*))) 47 | (unwind-protect 48 | (opengl:with-matrix-pushed 49 | (let ((scale (float 1/72 0d0))) 50 | (opengl:gl-scaled scale scale scale)) 51 | (ftgl:ftgl-set-font-display-list font (if (use-display-list obj) 0 1)) 52 | (ftgl:ftgl-set-font-face-size font 72 72) 53 | (ftgl:ftgl-set-font-depth font 5.0) 54 | (ftgl:ftgl-render-font font text ftgl:FTGL_RENDER_ALL)) 55 | (ftgl:ftgl-destroy-font font)))) 56 | 57 | #+(or mswindows ftgl) 58 | (defun draw-positioned-3d-text (obj text 59 | x-pos y-pos z-pos 60 | x-rotation y-rotation z-rotation 61 | scale) 62 | (with-3d-text-state-saved 63 | (opengl:gl-translated x-pos y-pos z-pos) 64 | (opengl:gl-scaled scale scale scale) 65 | (opengl:gl-rotated x-rotation 1.0d0 0.0d0 0.0d0) 66 | (opengl:gl-rotated y-rotation 0.0d0 1.0d0 0.0d0) 67 | (opengl:gl-rotated z-rotation 0.0d0 0.0d0 1.0d0) 68 | ;; Draw the text. 69 | (draw-3d-text obj text))) 70 | 71 | #+(or mswindows ftgl) 72 | (defmethod draw :after ((obj geom-object)) 73 | (let* ((text (name obj))) 74 | (when text 75 | (opengl:gl-color4-d 1d0 0.5d0 0.0d0 1.0d0) 76 | (if (listp text) 77 | (dolist (spec text) 78 | (apply 'draw-positioned-3d-text obj spec)) 79 | (let* ((vertexes (vertexes obj)) 80 | (vertex (aref vertexes 0))) 81 | (draw-positioned-3d-text obj text 82 | (opengl:gl-vector-aref vertex 0) 83 | (opengl:gl-vector-aref vertex 1) 84 | (opengl:gl-vector-aref vertex 2) 85 | -90d0 0d0 180d0 86 | 0.5d0)))))) 87 | 88 | -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/arrows.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/9/LISPopengl-examples/RCS/arrows.lisp,v 1.5.15.2 2021/11/22 20:41:02 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | (in-package "CL-USER") 6 | 7 | ;;; ---------------------------------------------------------------------- 8 | ;;; Load up the required generic images use #. reader syntax to embed the 9 | ;;; images within the fasl. 10 | ;;; ---------------------------------------------------------------------- 11 | 12 | 13 | (eval-when (compile eval) 14 | (defmacro register-button-image (pathname) 15 | (gp:read-external-image (merge-pathnames pathname (or #+LUCID *compile-file-pathname* 16 | (current-pathname)))))) 17 | 18 | 19 | (defvar *down-arrow* #.(register-button-image #p"./images/down-arrow.bmp")) 20 | (defvar *up-arrow* #.(register-button-image #p"./images/up-arrow.bmp")) 21 | (defvar *up-disabled* #.(register-button-image #p"./images/up-disabled.bmp")) 22 | (defvar *down-disabled* #.(register-button-image #p"./images/down-disabled.bmp")) 23 | 24 | (setf (gp:external-image-transparent-color-index *down-arrow*) 0 25 | (gp:external-image-transparent-color-index *up-arrow*) 0 26 | (gp:external-image-transparent-color-index *up-disabled*) 0 27 | (gp:external-image-transparent-color-index *down-disabled*) 0) 28 | -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/defsys.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/9/LISPopengl-examples/RCS/defsys.lisp,v 1.15.15.1 2021/07/12 15:10:02 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | 6 | (in-package "CL-USER") 7 | 8 | (defsystem "OPENGL-EXAMPLES" 9 | () 10 | :members 11 | (("OPENGL" :type :system :root-module nil) 12 | "arrows" 13 | "icosahedron" 14 | "texture" 15 | "3d-text") 16 | :rules 17 | ((:in-order-to :compile :all (:requires (:load "OPENGL"))) 18 | (:in-order-to :compile "icosahedron" (:requires (:load "arrows"))) 19 | )) 20 | 21 | -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/images/description.txt: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Text; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/9/LISPopengl-examples/RCS/images:description.txt,v 1.2.15.1 2021/07/12 15:10:02 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | Description of images 6 | 7 | up-arrow.bmp - up arrow 8 | down-arrow.bmp - down arrow 9 | up-disabled.bmp - disabled up arrow 10 | down-disabled.bmp - disabled down arrow 11 | -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/images/down-arrow.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/src/opengl-lw-8/examples/images/down-arrow.bmp -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/images/down-disabled.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/src/opengl-lw-8/examples/images/down-disabled.bmp -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/images/up-arrow.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/src/opengl-lw-8/examples/images/up-arrow.bmp -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/images/up-disabled.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/src/opengl-lw-8/examples/images/up-disabled.bmp -------------------------------------------------------------------------------- /src/opengl-lw-8/examples/load.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/9/LISPopengl-examples/RCS/load.lisp,v 1.8.1.1 2021/07/12 15:10:02 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | (in-package "CL-USER") 6 | 7 | (load (current-pathname "../load")) 8 | 9 | (load (current-pathname "defsys")) 10 | 11 | (compile-system "OPENGL-EXAMPLES" :load t :target-directory (get-temp-directory)) 12 | 13 | 14 | -------------------------------------------------------------------------------- /src/opengl-lw-8/host.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/61/LISPopengl/RCS/host.lisp,v 1.4.16.1 2021/07/12 15:10:01 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | 6 | (in-package "USER") 7 | 8 | (setf (logical-pathname-translations "OPENGL") 9 | `(("**;*" ,(merge-pathnames "**/*" (pathname-location *load-truename*))))) 10 | 11 | -------------------------------------------------------------------------------- /src/opengl-lw-8/load.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/61/LISPopengl/RCS/load.lisp,v 1.12.1.1 2021/07/12 15:10:01 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | (in-package "CL-USER") 6 | 7 | (load (current-pathname "defsys")) 8 | 9 | (compile-system "OPENGL" :load t :target-directory (get-temp-directory)) 10 | 11 | 12 | -------------------------------------------------------------------------------- /src/opengl-lw-8/loader.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/61/LISPopengl/RCS/loader.lisp,v 1.7.3.1 2021/07/12 15:10:01 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | 6 | (in-package "CL-USER") 7 | 8 | ;; Ensure a connection to the foreign OpenGL libraries. 9 | 10 | (eval-when (load eval) 11 | #+mswindows 12 | (progn 13 | (fli:register-module "OPENGL32" :connection-style :immediate) 14 | (fli:register-module "GLU32" :connection-style :immediate) 15 | ) 16 | 17 | #+Linux 18 | (progn 19 | 20 | ;; Ideally libGL.so and libGLU.so would be loaded directly, but 21 | ;; there might be problems most likely caused by libGLU.so not having 22 | ;; an SO_NEEDED dependency on libGL.so. As a workaround, create a 23 | ;; combined file beforehand as follows: 24 | ;; 25 | ;; $ cd /tmp; ld -shared -o gl.so -L/usr/X11R6/lib -lGLU -lGL -lm 26 | ;; or 27 | ;; $ cd /tmp; ld -shared -o gl64.so -L/usr/X11R6/lib64 -lGLU -lGL -lm 28 | ;; 29 | ;; (fli:register-module #-lispworks-64bit "/tmp/gl.so" 30 | ;; #+lispworks-64bit "/tmp/gl64.so" 31 | ;; :connection-style :immediate) 32 | 33 | (dolist (name '("-lGL" "-lGLU")) 34 | (fli:register-module name)) 35 | ) 36 | 37 | #+Darwin 38 | (cond ((member :cocoa *features*) 39 | (let ((root "/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/")) 40 | (fli:register-module (merge-pathnames "libGL.dylib" root)) 41 | (fli:register-module (merge-pathnames "libGLU.dylib" root)))) 42 | ((member :ffi-x11 *features*) 43 | (let ((root "/usr/X11R6/lib/")) 44 | (fli:register-module (merge-pathnames "libGL.dylib" root)) 45 | (fli:register-module (merge-pathnames "libGLU.dylib" root))))) 46 | 47 | #+FreeBSD 48 | (dolist (name '("-lGL" "-lGLU")) 49 | (fli:register-module name)) 50 | 51 | #+Solaris2 52 | (dolist (name '("-lGL" "-lGLU")) 53 | (fli:register-module name)) 54 | 55 | #+AIX 56 | (dolist (name '("-lGL" "-lGLU" 57 | "-lXext" "-lX11" "-lIM" ; Not obvious that these are needed 58 | )) 59 | (fli:register-module name)) 60 | 61 | #+HP-UX 62 | (link-load:read-foreign-modules "-L/opt/graphics/OpenGL/lib" 63 | "-lGL" "-lGLU") 64 | 65 | #+IRIX 66 | (link-load:read-foreign-modules "-lGLcore" "-lGL" "-lGLU" "-lX11") 67 | 68 | 69 | ) 70 | 71 | 72 | -------------------------------------------------------------------------------- /src/opengl-lw-8/types.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; rcs-header: "$Header: /hope/lwhope1-cam/hope.0/compound/61/LISPopengl/RCS/types.lisp,v 1.6.2.1 2021/07/12 15:10:01 martin Exp $" -*- 2 | 3 | ;; Copyright (c) 1987--2021 LispWorks Ltd. All rights reserved. 4 | 5 | (in-package "OPENGL") 6 | 7 | 8 | (fli:define-c-typedef (glenum (:foreign-name "GLenum")) 9 | (:unsigned :int)) 10 | 11 | (fli:define-c-typedef (glboolean (:foreign-name "GLboolean")) 12 | (:unsigned :char)) 13 | 14 | (fli:define-c-typedef (glbitfield (:foreign-name "GLbitfield")) 15 | (:unsigned :int)) 16 | 17 | (fli:define-c-typedef (glbyte (:foreign-name "GLbyte")) 18 | (:signed :char)) 19 | 20 | (fli:define-c-typedef (glshort (:foreign-name "GLshort")) 21 | (:signed :short)) 22 | 23 | (fli:define-c-typedef (glint (:foreign-name "GLint")) 24 | (:signed :int)) 25 | 26 | (fli:define-c-typedef (glsizei (:foreign-name "GLsizei")) 27 | (:signed :int)) 28 | 29 | (fli:define-c-typedef (glubyte (:foreign-name "GLubyte")) 30 | (:unsigned :char)) 31 | 32 | (fli:define-c-typedef (glushort (:foreign-name "GLushort")) 33 | (:unsigned :short)) 34 | 35 | (fli:define-c-typedef (gluint (:foreign-name "GLuint")) 36 | (:unsigned :int)) 37 | 38 | (fli:define-c-typedef (glfloat (:foreign-name "GLfloat")) 39 | :float) 40 | 41 | (fli:define-c-typedef (glclampf (:foreign-name "GLclampf")) 42 | :float) 43 | 44 | (fli:define-c-typedef (gldouble (:foreign-name "GLdouble")) 45 | :double) 46 | 47 | (fli:define-c-typedef (glclampd (:foreign-name "GLclampd")) 48 | :double) 49 | 50 | (fli:define-c-typedef (glvoid (:foreign-name "GLvoid")) 51 | :void) 52 | 53 | (fli:define-c-typedef (glintptr (:foreign-name "GLintptr")) 54 | (:pointer-integer :long)) 55 | 56 | (fli:define-c-typedef (glsizeiptr (:foreign-name "GLsizeiptr")) 57 | (:pointer-integer :long)) 58 | 59 | (fli:define-c-typedef (glchar (:foreign-name "GLchar")) 60 | :char) 61 | 62 | (fli:define-c-typedef glstring-return 63 | #+mswindows (w:lpstr :pass-by :reference) 64 | #-mswindows (:reference :ef-mb-string)) 65 | 66 | -------------------------------------------------------------------------------- /src/redisplay/blinkers.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; Code for painting the cursor/blinker. 17 | (in-package :boxer) 18 | 19 | ;; timing 20 | (defvar delta-time 0.0) ;; time between current frame and last frame 21 | (defvar last-frame 0.0) 22 | (defvar blinker-time 0.0) 23 | (defvar blinker-on t 24 | "Is the blinker cursor currently visible?") 25 | 26 | (defun toggle-blinker () 27 | (cond 28 | (blinker-on 29 | (setf boxer::*point-color* #(:rgb .3 .3 .9 .5)) 30 | (setf blinker-on nil) 31 | ) 32 | (t 33 | (setf boxer::*point-color* #(:rgb .3 .3 .9 .0)) 34 | (setf blinker-on t)))) 35 | 36 | (defun draw-blinker (blinker &key (color *blinker-color*)) 37 | (with-pen-color (color) 38 | (draw-rectangle (blinker-wid blinker) (blinker-hei blinker) 39 | (blinker-x blinker) (blinker-y blinker)))) 40 | -------------------------------------------------------------------------------- /src/redisplay/boxer-sunrise-redisplay.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem "boxer-sunrise-redisplay" 2 | :version "3.4.23" 3 | :author "Steven Githens" 4 | :license "BSD-3-Clause" 5 | :depends-on (:boxer-sunrise-core 6 | :boxer-sunrise-opengl) 7 | :components ((:file "blinkers") 8 | (:file "disply") 9 | (:file "lodisp") 10 | (:file "dev-overlay") 11 | (:file "repaint-2024") 12 | (:file "repaint-pass-2") 13 | (:file "repaint") 14 | (:file "new-borders") 15 | (:file "boxtops")) 16 | :description "Boxer Redisplay/repaint") 17 | -------------------------------------------------------------------------------- /src/redisplay/dev-overlay.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Boxer 2 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 3 | ;;;; 4 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 5 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 6 | ;;;; 7 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 8 | ;;;; 9 | ;;;; https://opensource.org/licenses/BSD-3-Clause 10 | ;;;; 11 | ;;;; 12 | ;;;; +-Data--+ 13 | ;;;; This file is part of the | BOXER | system 14 | ;;;; +-------+ 15 | ;;;; 16 | ;;;; This files contains the routines to paint the development/debug overlay on the boxer canvas with 17 | ;;;; various bits of helpful information. 18 | (in-package :boxer) 19 | 20 | (defvar *show-dev-overlay* nil 21 | "Whether or not paint the development and debug overlay in the corner.") 22 | 23 | (defun repaint-dev-overlay (&optional (process-state "")) 24 | "Debug information overlay on top of drawing canvas for things like framerate and zoom level" 25 | #+lispworks 26 | (if *show-dev-overlay* ;; factor out lispworks specific graphics-ports calls 27 | (drawing-on-window (*boxer-pane*) 28 | (let* ((code-font (make-boxer-font '("Courier New" 14))) 29 | (maxish-width (string-wid code-font "Repaint: 1000.00ms/fr")) 30 | (line-height (string-hei code-font)) 31 | (x (- (slot-value *boxer-pane* 'graphics-ports::width) (+ maxish-width 300))) 32 | (y (- (slot-value *boxer-pane* 'graphics-ports::height) 120)) 33 | (mx bw::*track-mouse-x*) 34 | (my bw::*track-mouse-y*) 35 | (mouse-bp (boxer::mouse-position-values mx my)) 36 | (mouse-screen-box (boxer::bp-screen-box mouse-bp)) 37 | (mouse-actual-obj (if mouse-screen-box (slot-value mouse-screen-box 'boxer::actual-obj) nil)) 38 | (mouse-style (if mouse-actual-obj (boxer::display-style-style (boxer::display-style-list mouse-actual-obj)) nil)) 39 | (debug-num 0) 40 | ) 41 | (with-pen-color (*blue*) 42 | (dolist (item (list (format nil "Repaint: ~$ms/fr" *current-framerate*) 43 | (format nil "Font Zoom: ~A%" (* *font-size-baseline* 100)) 44 | (format nil "Real Zoom: ~A%" (zoom-level *boxer-pane*)) 45 | (format nil "Process: ~A" process-state) 46 | (format nil "mx: ~A my: ~A d: ~A" bw::*track-mouse-x* bw::*track-mouse-y* bw::*mouse-down-p*) 47 | (format nil "dx: ~A dy: ~A" bw::*document-mouse-x* bw::*document-mouse-y*) 48 | (format nil "mouse status: ~A" (bw::mouse-doc-status-place)) 49 | (format nil "mouse x: ~A" (bw::mouse-doc-status-x)) 50 | (format nil "mouse y: ~A" (bw::mouse-doc-status-y)) 51 | (format nil "popup-doc: ~A" (bw::mouse-doc-status-popup-doc)) 52 | (format nil "popup-x: ~A" (bw::mouse-doc-status-popup-x)) 53 | (format nil "popup-y: ~A" (bw::mouse-doc-status-popup-y)) 54 | (format nil "mouse-style: ~A" mouse-style) 55 | ;; (format nil "name: ~A" (name mouse-actual-obj)) 56 | ;; (format nil "x-offset: ~A" (screen-obj-x-offset mouse-screen-box)) 57 | ;; (format nil "y-offset: ~A" (screen-obj-y-offset mouse-screen-box)) 58 | ;; (format nil "wid: ~A" (screen-obj-wid mouse-screen-box)) 59 | ;; (format nil "hei: ~A" (screen-obj-hei mouse-screen-box)) 60 | ;; (format nil "x-got-clipped?: ~A" (screen-obj-x-got-clipped? mouse-screen-box)) 61 | ;; (format nil "y-got-clipped?: ~A" (screen-obj-y-got-clipped? mouse-screen-box)) 62 | )) 63 | (draw-string code-font item x (+ 30 (* line-height debug-num))) 64 | (setf debug-num (1+ debug-num)) 65 | ) 66 | ))))) 67 | -------------------------------------------------------------------------------- /src/site/site.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode:LISP; Syntax:Common-Lisp; Package:boxer ; -*- 2 | 3 | 4 | 5 | 6 | 7 | #| 8 | 9 | Boxer 10 | Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 11 | 12 | Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 13 | used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 14 | 15 | Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 16 | 17 | https://opensource.org/licenses/BSD-3-Clause 18 | 19 | 20 | +-Data--+ 21 | This file is part of the | BOXER | system 22 | +-------+ 23 | 24 | 25 | Modification History (most recent at the top) 26 | 27 | 4/21/03 merged current LW and MCL files 28 | 7/15/00 started logging changes: *site-initialization-verbosity* changed 29 | to nil for non mcl systems 30 | 31 | This file contains code for site specific customizations 32 | 33 | |# 34 | 35 | (in-package :boxer) 36 | 37 | (defvar *site-initialization-verbosity* nil) 38 | 39 | ;;; Strings MUST BE COPIED !!!! 40 | (defun coerce-config-value (value-string type) 41 | (ecase type 42 | (:string (copy-seq value-string)) 43 | (:symbol (intern (string-upcase value-string) (find-package "BOXER"))) 44 | (:keyword (intern (string-upcase value-string) (find-package "KEYWORD"))) 45 | (:boolean (not (null 46 | (or (string-equal value-string "T") 47 | (string-equal value-string "True"))))) 48 | (:number (if (numberstring? value-string) 49 | (ignoring-number-read-errors 50 | (read-from-string value-string nil nil)) 51 | (progn (warn "Bad Number value for ~A, using 0" value-string) 52 | 0)) 53 | #| ; only handles decimal positive integers 54 | (let ((acc 0) (l (length value-string))) 55 | (dotimes (i l acc) 56 | (let ((val (digit-char-p (aref value-string i)))) 57 | (cond ((null val) 58 | (warn "Bad Number value for ~A, using ~A" 59 | value-string acc) 60 | (return acc)) 61 | (t (setq acc (+ (* acc 10) val))))))) |# 62 | ))) 63 | 64 | ;;; buffers + utilities 65 | ;;; if we wanted to, we could rewrite this using read/write-array 66 | ;;; but this is portable and speed is not a priority here 67 | 68 | (defvar *keyword-buffer* (make-array 255 69 | :element-type #-lucid 'character #+lucid 'string-char 70 | :fill-pointer 0 71 | :adjustable t)) 72 | 73 | (defvar *value-buffer* (make-array 255 74 | :element-type #-lucid 'character #+lucid 'string-char 75 | :fill-pointer 0 76 | :adjustable t)) 77 | 78 | (defun buffer-clear (buffer) 79 | (setf (fill-pointer buffer) 0)) 80 | 81 | #| 82 | 83 | The format of the site configuration file is as follows: 84 | 85 | o Comments are preceeded by the # character 86 | o Each line should consist of a token name 87 | followed by a colon and then a value for that token 88 | o Whitespace is (should be) ignored 89 | o Case is not important in the token names but it may be 90 | important in the values 91 | o Number values are in decimal 92 | 93 | |# 94 | 95 | (defun config-file-comment? (char) 96 | (or (char-equal char #\#) (char-equal char #\;))) 97 | 98 | (defvar *config-file-white-space-chars* '(#\space #\tab)) 99 | 100 | (defun config-file-whitespace? (char) 101 | (member char *config-file-white-space-chars* :test #'char-equal)) 102 | 103 | (defun config-file-eol? (char) 104 | (or (char-equal char #\return) (char-equal char #\newline))) 105 | 106 | (defun config-file-separator? (char) 107 | (char-equal char #\:)) 108 | 109 | ;; valid config lines can be whitespace, comments, or a keyword value pair 110 | (defun read-config-line (filestream keyword-buffer value-buffer) 111 | (declare (values valid-pair? eof? keyword value)) 112 | (let ((eof (list 'eof)) (stop-now? nil) 113 | (current-buffer keyword-buffer)) 114 | (flet ((flush-remaining-line () 115 | (do ((char (read-char filestream nil eof) 116 | (read-char filestream nil eof))) 117 | ((or (eq char eof) (config-file-eol? char)))))) 118 | (do ((char (read-char filestream nil eof) 119 | (read-char filestream nil eof))) 120 | ((or (eq char eof) (config-file-eol? char) stop-now?) 121 | (if (and (>& (length keyword-buffer) 0) 122 | (>& (length value-buffer) 0)) 123 | (values t (eq char eof) keyword-buffer value-buffer) 124 | (values nil (eq char eof)))) 125 | (cond ((config-file-whitespace? char)) 126 | ((config-file-comment? char) (flush-remaining-line) (return nil)) 127 | ((config-file-separator? char) 128 | (cond ((eq current-buffer value-buffer) 129 | (warn "Extra \":\" seen in line with ~A ~A..." 130 | keyword-buffer value-buffer) 131 | (flush-remaining-line) 132 | (setq stop-now? t)) 133 | ((>& (length current-buffer) 0) 134 | (setq current-buffer value-buffer)) 135 | (t (warn "Empty keyword, ignoring line") 136 | (flush-remaining-line) 137 | (return nil)))) 138 | (t 139 | ;; must be a valid character 140 | (vector-push-extend char current-buffer))))))) 141 | -------------------------------------------------------------------------------- /src/stepper/stepper-eval.lisp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Boxer 3 | ;;;; Copyright 1985-2022 Andrea A. diSessa and the Estate of Edward H. Lay 4 | ;;;; 5 | ;;;; Portions of this code may be copyright 1982-1985 Massachusetts Institute of Technology. Those portions may be 6 | ;;;; used for any purpose, including commercial ones, providing that notice of MIT copyright is retained. 7 | ;;;; 8 | ;;;; Licensed under the 3-Clause BSD license. You may not use this file except in compliance with this license. 9 | ;;;; 10 | ;;;; https://opensource.org/licenses/BSD-3-Clause 11 | ;;;; 12 | ;;;; 13 | ;;;; +------+ 14 | ;;;; This file is part of the |Boxer | System 15 | ;;;; +-Data-+ 16 | ;;;; 17 | 18 | (in-package :boxer-eval) 19 | 20 | (defun boxer-step-eval (iline &key process-state) 21 | (compiler-let ((*compiling-stepper* t)) 22 | (evaluator-body iline process-state))) 23 | -------------------------------------------------------------------------------- /tests/alternate-names-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | #+mac 6 | (progn 7 | (is (boxer::alternate-platform-input-names 97 2 :platform :mac) '(boxer-user::ctrl-a-key)) 8 | (is (boxer::alternate-platform-input-names 97 4 :platform :mac) '(boxer-user::alt-a-key)) 9 | ) 10 | 11 | #+win32 12 | (progn 13 | (is (boxer::alternate-platform-input-names 97 2 :platform :ibm-pc) '(boxer-user::control-a-key)) 14 | (is (boxer::alternate-platform-input-names 97 4 :platform :ibm-pc) '(boxer-user::s)) 15 | ) 16 | 17 | (finalize) 18 | -------------------------------------------------------------------------------- /tests/boxapp-data-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | ;; Tests for Recent Files 6 | 7 | ;;; 8 | ;;; get-boxapp-filepath 9 | ;;; 10 | 11 | (is (boxer::get-boxapp-data-filepath) #P"~/Library/Application Support/Boxer/boxapp-data.lisp" :test #'uiop:pathname-equal) 12 | 13 | (boxer::reset-recent-files) 14 | 15 | ;; Starting out the recent files should be empty 16 | (is (length (boxer::get-recent-files)) 0) 17 | 18 | (boxer::add-recent-file "/Users/sgithens/first/file.txt") 19 | 20 | (is (length (boxer::get-recent-files)) 1) 21 | 22 | (is (cdr (assoc :path (car (boxer::get-recent-files)))) "/Users/sgithens/first/file.txt") 23 | 24 | (boxer::add-recent-file "/Users/sgithens/second/file.txt") 25 | 26 | (is (length (boxer::get-recent-files)) 2) 27 | 28 | (boxer::add-recent-file "/Users/sgithens/third/file.box" "Third File") 29 | 30 | (is (length (boxer::get-recent-files)) 3) 31 | 32 | ;; After adding second again, the order should be Second, Third, First 33 | 34 | (boxer::add-recent-file "/Users/sgithens/second/file.txt") 35 | 36 | (is (length (boxer::get-recent-files)) 3 "Testing double entries") 37 | 38 | (finalize) 39 | -------------------------------------------------------------------------------- /tests/boxdef-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (print boxer::*constant-folding-macros*) 6 | 7 | ;; 8 | ;; boxdef.lisp tests 9 | ;; 10 | ;; Tests for basic box and row data structures 11 | ;; 12 | 13 | ;; Test a simple "WORLD" box with the statement `1 + 5` 14 | 15 | (defvar *simple-arithmetic-box* (make-instance 'boxer::data-box)) 16 | (setf (boxer::name *simple-arithmetic-box*) "WORLD") 17 | 18 | (defvar *simple-row* (make-instance 'boxer::row)) 19 | (setf (boxer::chas-array *simple-row*) #(#(#\1 #\ #\+ #\ #\5) 5 NIL NIL)) 20 | (setf (boxer::superior-box *simple-row*) *simple-arithmetic-box*) 21 | (setf (boxer::first-inferior-row *simple-arithmetic-box*) *simple-row*) 22 | 23 | (is (boxer::name *simple-arithmetic-box*) "WORLD") 24 | (is (boxer::chas-array (boxer::first-inferior-row *simple-arithmetic-box*)) 25 | #(#(#\1 #\ #\+ #\ #\5) 5 NIL NIL) :test #'equalp) 26 | 27 | (is (boxer::superior-box (boxer::first-inferior-row *simple-arithmetic-box*)) *simple-arithmetic-box*) 28 | (is (boxer::superior-box *simple-row*) *simple-arithmetic-box*) 29 | 30 | ;; TODO add tests for display type flags, multiple rows, and other fields 31 | 32 | (finalize) 33 | -------------------------------------------------------------------------------- /tests/boxer-styles-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | ;;; Tests for rgb->rgb-hex 6 | (is (boxer::rgb->rgb-hex #(:RGB 0.0D0 0.02345961332321167D0 0.9932165145874023D0 1.0D0)) 7 | #(:rgb-hex "#0005FD") :test #'equalp) 8 | 9 | ;;; Tests for setting and getting css values from plist-subclasses. In this case box. 10 | (let ((box (make-simple-box "CSS Test" "This is a box."))) 11 | ;; Starting out there should be no property 12 | (is (boxer::getprop box :css-styles nil) nil) 13 | 14 | (boxer::set-css-style box :background-color '#(:rgb-hex "#FFEEDD")) 15 | (is (length (boxer::getprop box :css-styles nil)) 2) 16 | (is (boxer::get-css-style box :background-color) '#(:rgb-hex "#FFEEDD") :test #'equalp) 17 | (is (boxer::get-css-style box :border-color) nil) 18 | 19 | 20 | (boxer::set-css-style box :border-color '#(:rgb-hex "#AABBCC")) 21 | (is (length (boxer::getprop box :css-styles nil)) 4) 22 | (is (boxer::get-css-style box :background-color) '#(:rgb-hex "#FFEEDD") :test #'equalp) 23 | (is (boxer::get-css-style box :border-color) '#(:rgb-hex "#AABBCC") :test #'equalp) 24 | 25 | 26 | (boxer::set-css-style box :background-color '#(:rgb-hex "#001122")) 27 | (is (length (boxer::getprop box :css-styles nil)) 4) 28 | (is (boxer::get-css-style box :background-color) '#(:rgb-hex "#001122") :test #'equalp) 29 | (is (boxer::get-css-style box :border-color) '#(:rgb-hex "#AABBCC") :test #'equalp) 30 | 31 | (boxer::remove-css-style box :border-color) 32 | (is (length (boxer::getprop box :css-styles nil)) 2) 33 | (is (boxer::get-css-style box :background-color) '#(:rgb-hex "#001122") :test #'equalp) 34 | (is (boxer::get-css-style box :border-color) nil) 35 | ) 36 | 37 | 38 | 39 | ; todo the below are important for the new border/background color work. FINISH THEM 40 | ; (let ((new-box (boxer::make-initialized-box-for-editor)) 41 | ; (copied-box (boxer::make-initialized-box-for-editor))) 42 | ; ;; without the style plist entries 43 | ; (setf (boxer::name new-box) "A test Box") 44 | 45 | ; (is (boxer::name new-box) "A test Box") 46 | 47 | ; (setf copied-box (boxer::copy-box new-box)) 48 | 49 | ; (is (boxer::name copied-box) "A test Box") 50 | 51 | ; (setf (boxer::name copied-box) "A copied Box") 52 | 53 | ; (is (boxer::name new-box) "A test Box") 54 | ; (is (boxer::name copied-box) "A copied Box") 55 | 56 | 57 | 58 | ; ;; tests to make sure the styles are copied using our copy hooks 59 | ; (setf (getf (boxer::plist new-box) 'boxer::border-background) "#123456") 60 | 61 | ; (is (getf (boxer::plist new-box) 'boxer::border-background) "#123456") 62 | ; (is (getf (boxer::plist copied-box) 'boxer::border-background) nil) 63 | 64 | ; (setf copied-box (boxer::copy-box new-box)) 65 | ; (is (getf (boxer::plist new-box) 'boxer::border-background) "#123456") 66 | ; (is (getf (boxer::plist copied-box) 'boxer::border-background) "#123456") 67 | 68 | ; (format t "the plist: ~A" (boxer::plist new-box)) 69 | ; (format t "the plis2: ~A" (boxer::plist copied-box)) 70 | 71 | ; ) 72 | 73 | 74 | 75 | 76 | (finalize) 77 | -------------------------------------------------------------------------------- /tests/boxer-sunrise.lisp: -------------------------------------------------------------------------------- 1 | (defpackage boxer-sunrise-test 2 | (:use :cl 3 | :boxer-sunrise 4 | :prove)) 5 | (in-package :boxer-sunrise-test) 6 | 7 | ;; NOTE: To run this test file, execute `(asdf:test-system :boxer-sunrise)' in your Lisp. 8 | (plan nil) 9 | 10 | (finalize) 11 | -------------------------------------------------------------------------------- /tests/click-handlers-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | ;; Currently wander is set to 5 pixels 6 | 7 | (is (bw::check-click-wander '(0 . 0) '(0 . 0)) t) 8 | 9 | (is (bw::check-click-wander '(2 . 3) '(4 . 5)) t) 10 | 11 | (is (bw::check-click-wander '(0 . 0) '(4 . 4)) t) 12 | 13 | (is (bw::check-click-wander '(0 . 0) '(5 . 5)) nil) 14 | 15 | (is (bw::check-click-wander '(0 . 0) '(6 . 6)) nil) 16 | 17 | (is (bw::check-click-wander '(2 . 3) '(8 . 3)) nil) 18 | 19 | (finalize) 20 | -------------------------------------------------------------------------------- /tests/comdef-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | ;;; Tests for editor-abort-char? 6 | ;;; At the moment we have Ctrl-g and Ctrl-. set to the abort chars, 7 | ;;; those this is configurable via *editor-abort-chars* 8 | 9 | (is (boxer::editor-abort-char? #\k) nil) 10 | 11 | (is (boxer::editor-abort-char? #\c) nil) 12 | 13 | (is (boxer::editor-abort-char? #\c 1) nil) 14 | 15 | (is (boxer::editor-abort-char? #\c 2) nil) 16 | 17 | (is (boxer::editor-abort-char? #\g 2) t) 18 | 19 | (is (boxer::editor-abort-char? #\. 2) t) 20 | 21 | 22 | (finalize) 23 | -------------------------------------------------------------------------------- /tests/data/boxfiles-boxer/test42.boxer: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/tests/data/boxfiles-boxer/test42.boxer -------------------------------------------------------------------------------- /tests/data/boxfiles-v12/hello-www.box: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/tests/data/boxfiles-v12/hello-www.box -------------------------------------------------------------------------------- /tests/data/boxfiles-v5/henri-sun-v5.box: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/tests/data/boxfiles-v5/henri-sun-v5.box -------------------------------------------------------------------------------- /tests/data/format-tests/hello.txt: -------------------------------------------------------------------------------- 1 | This is a small text document. 2 | -------------------------------------------------------------------------------- /tests/data/format-tests/really-a-png.box: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/tests/data/format-tests/really-a-png.box -------------------------------------------------------------------------------- /tests/data/testing/readme.md: -------------------------------------------------------------------------------- 1 | # Testing folder 2 | 3 | Rather than using operating system temp files and folders, this empty directory (other than this `readme` file) are 4 | here to dump intermediate files, such that they can be easily inspected in the case of failed tests. 5 | -------------------------------------------------------------------------------- /tests/data/unique-filenames/test1/Untitled 2.box: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/tests/data/unique-filenames/test1/Untitled 2.box -------------------------------------------------------------------------------- /tests/data/unique-filenames/test2/Untitled 1.box: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/tests/data/unique-filenames/test2/Untitled 1.box -------------------------------------------------------------------------------- /tests/data/unique-filenames/test2/Untitled 2.box: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/tests/data/unique-filenames/test2/Untitled 2.box -------------------------------------------------------------------------------- /tests/data/unique-filenames/test2/Untitled.box: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/boxer-project/boxer-sunrise/64054d40c94724f4340974f9f54b62335985d68b/tests/data/unique-filenames/test2/Untitled.box -------------------------------------------------------------------------------- /tests/disdcl-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (let ((test-sb (make-instance 'boxer::screen-box))) 6 | 7 | ;; test to make sure the accessors always deal in fixnums regardless of 8 | ;; what might get jammed in the slot 9 | (setf (slot-value test-sb 'boxer::wid) 4.0) 10 | (is (boxer::screen-obj-wid test-sb) 4) 11 | (ok (integerp (boxer::screen-obj-wid test-sb))) 12 | (ok (not (floatp (boxer::screen-obj-wid test-sb)))) 13 | 14 | (setf (boxer::screen-obj-wid test-sb) 5.2) 15 | (is (boxer::screen-obj-wid test-sb) 5) 16 | (ok (integerp (boxer::screen-obj-wid test-sb))) 17 | (ok (not (floatp (boxer::screen-obj-wid test-sb)))) 18 | 19 | (setf (slot-value test-sb 'boxer::hei) 4.0) 20 | (is (boxer::screen-obj-hei test-sb) 4) 21 | (ok (integerp (boxer::screen-obj-hei test-sb))) 22 | (ok (not (floatp (boxer::screen-obj-hei test-sb)))) 23 | 24 | (setf (boxer::screen-obj-hei test-sb) 5.2) 25 | (is (boxer::screen-obj-hei test-sb) 5) 26 | (ok (integerp (boxer::screen-obj-hei test-sb))) 27 | (ok (not (floatp (boxer::screen-obj-hei test-sb)))) 28 | ) 29 | 30 | (finalize) 31 | -------------------------------------------------------------------------------- /tests/draw-high-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (let* ((clip-stack-1 '((16 29 628 407))) 6 | (clip-stack-2 '((16 29 628 407) 7 | (34 -425 689 693)))) 8 | (is (boxer::calculate-clip-rectangle clip-stack-1) 9 | '(16 29 628 407) 10 | "Clipping rectangle 1 level deep") 11 | (is (boxer::calculate-clip-rectangle clip-stack-2) 12 | '(34 29 628 407) 13 | "Clipping rectangle 2 levels deep")) 14 | 15 | (finalize) 16 | -------------------------------------------------------------------------------- /tests/draw-low-opengl-tests.lisp: -------------------------------------------------------------------------------- 1 | ;; Unit tests for various files of our openGL shaders work 2 | (in-package :boxer-sunrise-test) 3 | 4 | (plan nil) 5 | 6 | (let ((fvec (boxer::float-vector 0.0 4 5 1.2 0 23 19))) 7 | (is fvec #(0.0 4 5 1.2 0 23 19) :test #'equalp) 8 | (map 'vector (lambda (it) (ok (floatp it))) fvec) 9 | ) 10 | 11 | (finalize) 12 | -------------------------------------------------------------------------------- /tests/dumper-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (let ((henri-sun-v5 (merge-pathnames "data/boxfiles-v5/henri-sun-v5.box" 6 | (make-pathname :directory (pathname-directory *load-truename*)))) 7 | (www-box-v12 (merge-pathnames "data/boxfiles-v12/hello-www.box" 8 | (make-pathname :directory (pathname-directory *load-truename*))))) 9 | (is (boxer::get-box-file-format-version henri-sun-v5) 5) 10 | (is (boxer::get-box-file-format-version www-box-v12) 12) 11 | ) 12 | 13 | ;; 2022-09-03 Preparing tests for the new zipped file format 14 | 15 | (defun simple-name-timestamp () 16 | "Returns a simple timestamp in the form 2022-09-15_10-23. Avoids using any punctuation that might keep 17 | if from being used in a valid filename." 18 | (multiple-value-bind (sec min hour day mon year) 19 | (decode-universal-time (get-universal-time)) 20 | (format nil "~A-~A-~A_~A-~A-~A" year mon day hour min sec))) 21 | 22 | ;;; For the new data format .boxer 23 | ;;; - Have an existing boxer world in .box format 24 | ;;; - Open it up and resave it in .boxer format 25 | ;;; - Manually unzip the zip file, then compare the md5's of the original one and zipped one 26 | 27 | ;; Basic test of creating a box structure, saving it, re-opening it, and verifying a few bits 28 | (let* ((boxer::*draw-status-line* nil) 29 | (current-time (simple-name-timestamp)) 30 | (new-tests-dir (cl-fad:merge-pathnames-as-directory cl-user::*boxer-project-dir* 31 | (format nil "tests/data/testing/~A/" current-time))) 32 | (zip-results-dir (cl-fad:merge-pathnames-as-directory new-tests-dir "unzip-results/")) 33 | (newbox (make-instance 'boxer::data-box)) 34 | (reopened-box nil) 35 | (zipped-reopened-box nil)) 36 | 37 | (uiop:ensure-all-directories-exist (list new-tests-dir zip-results-dir)) 38 | (setf (boxer::name newbox) "WORLD") 39 | (boxer::bash-box-to-number newbox 42) 40 | (is (format nil "~A" newbox) "#") 41 | 42 | (boxer::dump-top-level-box newbox 43 | (cl-fad:merge-pathnames-as-file new-tests-dir "test42.box")) 44 | (setf reopened-box 45 | (boxer::read-internal 46 | (cl-fad:merge-pathnames-as-file new-tests-dir "test42.box"))) 47 | 48 | (is (format nil "~A" reopened-box) "#") 49 | 50 | ;; Save to the new .boxer format 51 | (boxer::save-box-to-boxer-document-format-zipped newbox 52 | (cl-fad:merge-pathnames-as-file new-tests-dir "test42.boxer")) 53 | 54 | ;; Unzip the freshly created .boxer file 55 | (zip:unzip (cl-fad:merge-pathnames-as-file new-tests-dir "test42.boxer") zip-results-dir) 56 | 57 | ;; Ensure the existence of /boxer/document.box 58 | (ok (cl-fad:merge-pathnames-as-file zip-results-dir "boxer/document.box")) 59 | 60 | ;; Open it to verify the contents 61 | (setf zipped-reopened-box 62 | (boxer::read-internal 63 | (cl-fad:merge-pathnames-as-file zip-results-dir "boxer/document.box"))) 64 | 65 | (is (format nil "~A" zipped-reopened-box) "#") 66 | 67 | ;; Compare the md5 of the original .box file and the freshly unzipped one 68 | (is (md5:md5sum-file (cl-fad:merge-pathnames-as-file zip-results-dir "boxer/document.box")) 69 | (md5:md5sum-file (cl-fad:merge-pathnames-as-file new-tests-dir "test42.box")) 70 | :test #'equalp) 71 | ) 72 | 73 | (finalize) 74 | -------------------------------------------------------------------------------- /tests/formats-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (defun make-simple-box (name contents) 6 | "An easy way to make a box quick for testing. Takes the name for the box and contents. 7 | Contents should be a single string that will populate the first row of the box." 8 | (let ((togo (make-instance 'boxer::data-box))) 9 | (setf (boxer::name togo) name) 10 | (boxer::bash-box-to-single-value togo contents) 11 | togo)) 12 | 13 | ;; Tests for defun file-type 14 | (let* ((boxer::*draw-status-line* nil) 15 | (current-time (simple-name-timestamp)) 16 | (tests-dir (cl-fad:merge-pathnames-as-directory cl-user::*boxer-project-dir* 17 | (format nil "tests/data/testing/~A/" current-time))) 18 | (boxer-document (merge-pathnames "data/boxfiles-boxer/test42.boxer" 19 | (make-pathname :directory (pathname-directory *load-truename*)))) 20 | (a-text-file (merge-pathnames "data/format-tests/hello.txt" 21 | (make-pathname :directory (pathname-directory *load-truename*)))) 22 | (a-png (merge-pathnames "data/format-tests/really-a-png.box" 23 | (make-pathname :directory (pathname-directory *load-truename*)))) 24 | (www-box-v12 (merge-pathnames "data/boxfiles-v12/hello-www.box" 25 | (make-pathname :directory (pathname-directory *load-truename*)))) 26 | (text-box-to-save (make-simple-box "txtbox" "ABCD")) 27 | (text-box-filename (cl-fad:merge-pathnames-as-file tests-dir "text-box.txt")) 28 | (bin-box-to-save (make-simple-box "binbox" "EFG")) 29 | (bin-box-filename (cl-fad:merge-pathnames-as-file tests-dir "bin-box.box")) 30 | (zip-box-to-save (make-simple-box "zipbox" "HIJK")) 31 | (zip-box-filename (cl-fad:merge-pathnames-as-file tests-dir "zip-box.boxer")) 32 | 33 | (text-box-to-save2 (make-simple-box "txtbox" "ABCD2")) 34 | (text-box-filename2 (cl-fad:merge-pathnames-as-file tests-dir "text-box2.txt")) 35 | (bin-box-to-save2 (make-simple-box "binbox" "EFG2")) 36 | (bin-box-filename2 (cl-fad:merge-pathnames-as-file tests-dir "bin-box2.box")) 37 | (zip-box-to-save2 (make-simple-box "zipbox" "HIJK2")) 38 | (zip-box-filename2 (cl-fad:merge-pathnames-as-file tests-dir "zip-box2.boxer"))) 39 | 40 | (is (boxer::file-type boxer-document) :application/boxer.document) 41 | (is (boxer::file-type a-text-file) :text) 42 | ; (is (boxer::file-type a-png) :text) 43 | (is (boxer::file-type www-box-v12) :application/box) 44 | 45 | (is (format nil "~A" (boxer::read-internal-1 boxer-document)) "#") 46 | (is (format nil "~A" (boxer::read-internal-1 a-text-file)) "#") 47 | ;; TODO sgithens, We need to alter the file-type code a bit to still check the box magic 48 | ;; number if it can probe the file. 49 | ; (is (format nil "~A" (boxer::read-internal-1 a-png)) "#") 50 | (is (format nil "~A" (boxer::read-internal-1 www-box-v12)) "#") 51 | 52 | ;; Some tests for save-generic from file-prims.lisp 53 | 54 | (boxer::save-generic text-box-to-save text-box-filename :format :text/plain) 55 | (boxer::save-generic bin-box-to-save bin-box-filename :format :application/box) 56 | (boxer::save-generic zip-box-to-save zip-box-filename :format :application/boxer.document) 57 | 58 | (is (format nil "~A" (boxer::read-internal-1 text-box-filename)) "#") 59 | (is (format nil "~A" (boxer::read-internal-1 bin-box-filename)) "#") 60 | (is (format nil "~A" (boxer::read-internal-1 zip-box-filename)) "#") 61 | 62 | ;; make sure it works detecting the format on it's own (no :format parameter...) 63 | (boxer::save-generic text-box-to-save2 text-box-filename2 :format :text/plain) 64 | (boxer::save-generic bin-box-to-save2 bin-box-filename2) 65 | (boxer::save-generic zip-box-to-save2 zip-box-filename2) 66 | 67 | (is (format nil "~A" (boxer::read-internal-1 text-box-filename2)) "#") 68 | (is (format nil "~A" (boxer::read-internal-1 bin-box-filename2)) "#") 69 | (is (format nil "~A" (boxer::read-internal-1 zip-box-filename2)) "#") 70 | 71 | ;; Unique filename tests 72 | (is (boxer::untitled-filename (merge-pathnames "data/unique-filenames/test1/" 73 | (make-pathname :directory (pathname-directory *load-truename*)))) "Untitled.box") 74 | (is (boxer::untitled-filename (merge-pathnames "data/unique-filenames/test2/" 75 | (make-pathname :directory (pathname-directory *load-truename*)))) "Untitled 3.box") 76 | 77 | ) 78 | 79 | 80 | 81 | (finalize) 82 | -------------------------------------------------------------------------------- /tests/freetype-fonts-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (let ((atlas (make-instance 'boxer::glyph-atlas))) 6 | (is (boxer::closest-font-size atlas 15) 7 | 16 "Closest glyph-atlas size: 15 -> 16") 8 | (is (boxer::closest-font-size atlas 12) 9 | 12 "Closest glyph-atlas size: 12 -> 12") 10 | (is (boxer::closest-font-size atlas 7) 11 | 8 "Closest glyph-atlas size: 7 -> 8") 12 | (is (boxer::closest-font-size atlas 73) 13 | 288 "Closest glyph-atlas size: 73 -> 288") 14 | (is (boxer::closest-font-size atlas 289) 15 | 288 "Closest glyph-atlas size: 289 -> 288")) 16 | 17 | (finalize) 18 | -------------------------------------------------------------------------------- /tests/gdispl-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | ;; Tests for allocate-window->boxer-command 6 | 7 | 8 | (is (boxer::allocate-window->boxer-command #(4 #(:RGB 1.0 0.0 0.0 1.0))) 9 | #(36 #(:RGB 1.0 0.0 0.0 1.0)) :test #'equalp) 10 | 11 | (is (boxer::allocate-window->boxer-command #(36 #(:RGB 1.0 0.0 0.0 1.0))) 12 | #(36 #(:RGB 1.0 0.0 0.0 1.0)) :test #'equalp) 13 | 14 | (let ((boxer::%drawing-half-width 50) 15 | (boxer::%drawing-half-height 25) 16 | (bitmap-before #(15 "blah" 40 30 20 50)) 17 | (bitmap-after nil)) 18 | ;; need to test: x-transform, y-transform, coerce, nil 19 | ;; boxer-centered-bitmap contains all 3 20 | ;; '(nil :x-transform :y-transform :coerce :coerce) 21 | ;; Result should be: #(47 "blah" 40 30 20.0 50.0) 22 | ;; (setf bitmap-after (boxer::allocate-window->boxer-command #(15 "blah" 40 30 20 50))) 23 | (is (boxer::allocate-window->boxer-command #(15 "blah" 40 30 20 50)) 24 | #(47 "blah" -10.0 -5.0 20.0 50.0) :test #'equalp) 25 | 26 | ) 27 | 28 | 29 | (finalize) 30 | -------------------------------------------------------------------------------- /tests/keydef-high-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (is (boxer::remove-shift-bit 0) 0) 6 | (is (boxer::remove-shift-bit 1) 0) 7 | (is (boxer::remove-shift-bit 2) 2) 8 | (is (boxer::remove-shift-bit 3) 2) 9 | (is (boxer::remove-shift-bit 4) 4) 10 | (is (boxer::remove-shift-bit 5) 4) 11 | (is (boxer::remove-shift-bit 6) 6) 12 | (is (boxer::remove-shift-bit 7) 6) 13 | (is (boxer::remove-shift-bit 8) 8) 14 | (is (boxer::remove-shift-bit 9) 8) 15 | (is (boxer::remove-shift-bit 10) 10) 16 | (is (boxer::remove-shift-bit 11) 10) 17 | (is (boxer::remove-shift-bit 12) 12) 18 | (is (boxer::remove-shift-bit 13) 12) 19 | (is (boxer::remove-shift-bit 14) 14) 20 | (is (boxer::remove-shift-bit 15) 14) 21 | 22 | ;;; The tables `*default-mouse-click-name-translation-table*` and 23 | ;;; `*key-names*` are usually bound by now. 24 | 25 | ;; Check the #\a key (97 ascii as a safe example) 26 | (is (symbol-name (boxer::lookup-key-name 97 0)) "A-KEY") 27 | (is (symbol-name (boxer::lookup-key-name 97 1)) "SHIFT-A-KEY") 28 | (is (symbol-name (boxer::lookup-key-name 97 2)) "CONTROL-A-KEY") 29 | 30 | (is (symbol-name (boxer::lookup-click-name 0 0)) "MOUSE-CLICK") 31 | (is (symbol-name (boxer::lookup-click-name 2 1)) "SHIFT-MOUSE-RIGHT-CLICK") 32 | 33 | ;;; Tests for lookup-input-name, which can take a character, number, mouse-event 34 | ;;; or gesture-spec 35 | 36 | ;; character 37 | (is (symbol-name (boxer::lookup-input-name #\a)) "A-KEY") 38 | 39 | ;; number 40 | (is (symbol-name (boxer::lookup-input-name 51)) "3-KEY") 41 | 42 | ;; mouse-event 43 | ;; This may require having more of the editor system spun up as it calculates boundaries 44 | ;; and click areas. 45 | ; (is (symbol-name (boxer::lookup-input-name (bw::make-mouse-event))) "MOUSE-CLICK") 46 | 47 | ;; gesture-spec 48 | #+lispworks (is (symbol-name (boxer::lookup-input-name (boxer::make-gesture-spec 97 0))) "A-KEY") 49 | 50 | (finalize) 51 | -------------------------------------------------------------------------------- /tests/loader-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (let ((boxer::*draw-status-line* nil) 6 | (henri-sun-v5 (merge-pathnames "data/boxfiles-v5/henri-sun-v5.box" 7 | (make-pathname :directory (pathname-directory *load-truename*))))) 8 | 9 | ;; Ensure this is the actual original bits, and has never been resaved 10 | ;; and updated/fixed as part of the save process. 11 | (is "24C084326289A1021BB0EF266838EF00" 12 | (with-output-to-string (str) 13 | (loop for x across 14 | (md5:md5sum-file henri-sun-v5) 15 | do (format str "~2,'0X" x)))) 16 | 17 | (is t 18 | (boxer:data-box? (boxer::load-binary-box-internal henri-sun-v5))) 19 | 20 | ) 21 | (finalize) 22 | -------------------------------------------------------------------------------- /tests/stacks-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (is (boxer-eval::make-stack-frame-cache 5) 6 | #(0 #(NIL NIL NIL NIL NIL)) :test #'equalp) 7 | 8 | (is (boxer-eval::stack-frame-cache-contents #(0 #(NIL NIL NIL NIL NIL))) 9 | #(NIL NIL NIL NIL NIL) :test #'equalp) 10 | 11 | (is (boxer-eval::make-stack-frame "TheStack" 5) 12 | '("TheStack" nil nil nil nil) :test #'equalp) 13 | 14 | (is (boxer-eval::make-n-stack-frames 4 "AwesomeStack" 5) 15 | #(0 #(("AwesomeStack" NIL NIL NIL NIL) ("AwesomeStack" NIL NIL NIL NIL) ("AwesomeStack" NIL NIL NIL NIL) ("AwesomeStack" NIL NIL NIL NIL))) 16 | :test #'equalp) 17 | 18 | (finalize) 19 | -------------------------------------------------------------------------------- /tests/vrtdef-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | ;; This test is absolutely critical to run regularly in 6 | ;; the number of fields in the vc-rows-entry structure 7 | ;; ever changes. It's pretty wierd, see comments on 8 | ;; vc-rows-entry and vc-rows-entry? in vrtdef.lisp 9 | ;; 10 | ;; Basically the underlying struct is setup to be stored 11 | ;; as a plain vector, and the predicate we have essentially 12 | ;; depends on the length of this simple vector. 13 | (is (length (boxer::%make-vc-rows-entry)) 10) 14 | 15 | 16 | (let ((vcr (boxer::%make-vc-rows-entry))) 17 | (is t (boxer::vc-rows-entry? vcr)) 18 | (is nil (boxer::vc-rows-entry? (subseq vcr 0 9)))) 19 | 20 | (finalize) 21 | -------------------------------------------------------------------------------- /tests/wrap-line-tests.lisp: -------------------------------------------------------------------------------- 1 | (in-package :boxer-sunrise-test) 2 | 3 | (plan nil) 4 | 5 | (let ((boxer::%drawing-height 200) 6 | (boxer::%drawing-width 300) 7 | (boxer::%drawing-half-height 100) 8 | (boxer::%drawing-half-width 150)) 9 | 10 | (is (boxer-wrap::wrap-y-coord-top 150) -50) 11 | (is (boxer-wrap::wrap-y-coord-bottom -125) 75) 12 | (is (boxer-wrap::wrap-x-coord-left -175) 125) 13 | (is (boxer-wrap::wrap-x-coord-right 200) -100) 14 | 15 | (ok (boxer-wrap::beyond-top? 100.1)) 16 | (ok (null (boxer-wrap::beyond-top? 100))) 17 | (ok (null (boxer-wrap::beyond-top? -24))) 18 | 19 | (ok (null (boxer-wrap::beyond-bottom? 34))) 20 | (ok (null (boxer-wrap::beyond-bottom? -100.0))) 21 | (ok (boxer-wrap::beyond-bottom? -100.1)) 22 | 23 | (ok (boxer-wrap::beyond-left? -150.1)) 24 | (ok (null (boxer-wrap::beyond-left? -150))) 25 | (ok (null (boxer-wrap::beyond-left? 23))) 26 | 27 | (ok (boxer-wrap::beyond-right? 150.1)) 28 | (ok (null (boxer-wrap::beyond-right? 150))) 29 | (ok (null (boxer-wrap::beyond-right? -24))) 30 | 31 | (is (boxer-wrap::top-x-intercept 100 200 2) 50 "x-intercept 1") 32 | (is (boxer-wrap::top-x-intercept 0 250 -2) 75 "x-intercept 2") 33 | 34 | (is (boxer-wrap::bottom-x-intercept -50 -250 2) 25) 35 | (is (boxer-wrap::bottom-x-intercept -50 -150 -2) -75) 36 | 37 | (is (boxer-wrap::left-y-intercept -200 -50 1/3) -100/3) 38 | 39 | (is (boxer-wrap::right-y-intercept 250 125 75/50) -25) 40 | 41 | (let ((draw-count 0)) 42 | (labels ((test-draw-line (x0 y0 x1 y1) 43 | (progn 44 | (format t "~%test-draw-line: x0: ~A y0: ~A x1: ~A y1: ~A" x0 y0 x1 y1) 45 | (incf draw-count)) 46 | )) 47 | (boxer-wrap::draw-wrap-line 0 0 10 10 #'test-draw-line) 48 | (is draw-count 1 "Simple wrap line") 49 | 50 | ;; I believe this test will exhaust the stack 51 | (setf boxer::%drawing-height 451) 52 | (setf boxer::%drawing-width 334) 53 | (setf boxer::%drawing-half-width 225.5) 54 | (setf boxer::%drawing-half-height 167.0) 55 | (boxer-wrap::draw-wrap-line 225.5 144.136 225.5 144.136 #'test-draw-line) 56 | (is 1 1 "2nd case") 57 | 58 | ;; Stack overflow from dragging CATT with pen segments 59 | (setf boxer::%drawing-height 462) 60 | (setf boxer::%drawing-width 787) 61 | (setf boxer::%drawing-half-width 393.5) 62 | (setf boxer::%drawing-half-height 231.0) 63 | (boxer-wrap::draw-wrap-line -393.5 342.0 -410.5 343.0 #'test-draw-line) 64 | (is 1 1 "3rd case") 65 | 66 | (setf boxer::%drawing-height 434) 67 | (setf boxer::%drawing-width 861) 68 | (setf boxer::%drawing-half-width 430.5) 69 | (setf boxer::%drawing-half-height 217.0) 70 | (boxer-wrap::draw-wrap-line -227.5 215.5 -233.5 217.5 #'test-draw-line) 71 | (is 1 1 "4th case") 72 | 73 | ;; Division by zero in top-x-intercept 74 | (setf boxer::%drawing-height 394) 75 | (setf boxer::%drawing-width 484) 76 | (setf boxer::%drawing-half-width 242.0) 77 | (setf boxer::%drawing-half-height 197.0) 78 | (boxer-wrap::draw-wrap-line -277.5 399.5 -297.5 399.5 #'test-draw-line) 79 | (is 1 1 "5th case") 80 | 81 | ))) 82 | 83 | (finalize) 84 | --------------------------------------------------------------------------------