STLViewer - a first approach for a wapp-lication

JOB 2018-02-24, The purpose of this code is merely to get familiar with wapp, a web application framework written in tcl.

The program emulates a local web server and requires an up-to-date web browser installation. The STL viewer is implemented with jquery.js and three.js. Once wapp takes precedence, the browser pops up and one can drag and drop a STL file onto the window...

WikiDBImage STLViewer.png

Q: What I could not manage was to tell the web server to deliver a binary file at runtime? Maybe someone else can give me some advice, how to achieve this (please see comments in code).

Here is the source code to establish the STL-Viewer in the browser window. I am only publishing the tcl part here. The complete sources can be downloaded from here: http://www.johann-oberdorfer.eu/blog/2018/02/24/18-02-24_stl_viewer/

# -------------------------------------------------------------------------
# (c) 2018, Johann Oberdorfer - Engineering Support | CAD | Software
#     johann.oberdorfer [at] gmail.com
#     www.johann-oberdorfer.eu
# -------------------------------------------------------------------------
# This source file is distributed under the BSD license.
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#   See the BSD License for more details.
# -------------------------------------------------------------------------
# Credits:
#        Thanks to D. Richard Hipp - the the creator of wapp,
#   a web application framework distributed as a single file and
#   with an extremely small footprint.
#
# Revision history:
#   18-02-24: JOB, Initial release
# -------------------------------------------------------------------------

set dir [file dirname [info script]]
source [file join $dir "./wapp.tcl"]

package require wapp


proc wapp-page-fullenv {} {
  wapp-set-cookie env-cookie full
  wapp "<h1>Wapp Full Environment</h1>\n"
  wapp-unsafe "<form method='POST' action='[wapp-param SELF_URL]'>\n"
  wapp "<input type='checkbox' name='var1'"
  if {[wapp-param-exists showhdr]} {
    wapp " checked"
  }
  # Deliberately unsafe calls to wapp-subst and wapp-trim, added here
  # to test wapp-safety-check
  #
  wapp-subst "> Var1\n"
  wapp-trim "<input type='submit' name='s1' value='Go'>\n"
  wapp "<input type='hidden' name='hidden-parameter-1' "
  wapp "value='the long value / of ?$ hidden-1..<hi>'>\n"
  wapp "</form>"
  wapp "<pre>\n"
  foreach var [lsort [wapp-param-list]] {
    if {$var==".reply"} continue
    wapp-subst {%html($var) = %html([list [wapp-param $var]])\n\n}
  }
  wapp "</pre>"
  wapp-subst {<p><a href='%html([wapp-param BASE_URL])/'>Home</a></p>\n}
}

proc readfile {fname} {
        set fp [open $fname "r"]
        set content [read $fp]
        close $fp
        return $content
}

proc readbinaryfile {fname} {
        set fp [open $fname "r"]
        fconfigure $fp -translation binary
        set content [read $fp]
        close $fp
        return [binary encode base64 $content]
}

proc wapp-page-stlviewer.css {} {
        set content [readfile [file join [wapp-param DOCUMENT_ROOT] "css/stlviewer.css"]]
        wapp-mimetype text/javascript
        return [wapp-trim { %unsafe($content) }]
}

proc wapp-page-dg.css {} {
        set content [readfile [file join [wapp-param DOCUMENT_ROOT] "css/dg.css"]]
        wapp-mimetype text/javascript
        return [wapp-trim { %unsafe($content) }]
}

proc wapp-page-three.js {} {
        set content [readfile [file join [wapp-param DOCUMENT_ROOT] "vendor/three.js"]]
        wapp-mimetype text/javascript
        return [wapp-trim { %unsafe($content) }]
}

proc wapp-page-jquery.js {} {
        set content [readfile [file join [wapp-param DOCUMENT_ROOT] "vendor/jquery.js"]]
        wapp-mimetype text/javascript
        return [wapp-subst { %unsafe($content) }]
}


proc wapp-page-dat.gui.min.js {} {
        set content [readfile [file join [wapp-param DOCUMENT_ROOT] "vendor/dat.gui.min.js"]]
        wapp-mimetype text/javascript
        return [wapp-trim { %unsafe($content) }]
}

proc wapp-page-stats.min.js {} {
        set content [readfile [file join [wapp-param DOCUMENT_ROOT] "vendor/stats.min.js"]]
        wapp-mimetype text/javascript
        return [wapp-trim { %unsafe($content) }]
}

proc wapp-page-main.js {} {
        set content [readfile [file join [wapp-param DOCUMENT_ROOT] "main.js"]]
        wapp-mimetype text/javascript
        return [wapp-trim { %unsafe($content) }]
}

# does not work so far !? ...

proc wapp-page-gyroid_V2_bin.stl_xxxx {} {
        set content [readbinaryfile [file join [wapp-param DOCUMENT_ROOT] "gyroid_V2_bin.stl"]]
        # wapp-content-security-policy {default-src 'inline' 'unsafe-inline'}
        # wapp-mimetype text/javascript
        return [wapp-unsafe [binary decode base64 {$content}]]
}

proc wapp-page-gyroid_V2_bin.stl {} {
        set content [readbinaryfile [file join [wapp-param DOCUMENT_ROOT] "gyroid_V2_bin.stl"]]
        return [wapp-trim [binary decode base64 { %unsafe($content) }]]
}


# The default page paints a form to be submitted.
# The default content-security-policy of Wapp restricts the use
# of in-line javascript, so the script content must be returned by
# a separate resource.
#
proc wapp-default {} {
        global wapp

        set B [wapp-param BASE_URL]
        
        wapp-cache-control max-age=15        

        # wapp "<!DOCTYPE html>\n"
        wapp "<html>\n"
        wapp "        <head>\n"
        wapp "        <title>STL Viewer</title>\n"

        wapp-trim {
            <link href='%url($B)/stlviewer.css' rel="stylesheet">

                <script src='%url($B)/three.js'></script>
                <script src='%url($B)/jquery.js'></script>
                <script src='%url($B)/dat.gui.min.js'></script>
                <script src='%url($B)/stats.min.js'></script>
                <script src='%url($B)/main.js'></script>

                <link href='%url($B)/dg.css' rel="stylesheet">
        }

        wapp "\n<script>\n"

        wapp-content-security-policy {'unsafe-inline'}
        wapp-trim {

      $(document).ready(function() {
        var stats = new Stats();
        stats.setMode( 0 );

        stats.domElement.style.position = 'absolute';
        stats.domElement.style.top = '2px';
        stats.domElement.style.left = '2px';

        var id = "stlviewer";
        var config = {stats: stats, dragDrop: true, autoRotate: true, startupAnimation: true, zoom: true};
        var viewer = new ModelViewer(document.getElementById(id),config);

        window.viewer = viewer;

        var gui = new dat.GUI();

        var Configuration = function() {
          this.color   = "#98AFC7";
          this.BodyBgColor = "#000000";
          this.wireframe = false;
          this.plane = true;
          this.boundingBox = true;
          this.sphere = false;
          this.axis = false;
          this.autorotate = true;
          this.material = true;
          this.zoom = config.zoom;

          this.model = '';
          this.modelSamples = { "" : "" }
        };
        var cfg = new Configuration();

        // viewer.load('%url($B)/gyroid_V2_bin.stl');
                viewer.load('');

        gui.addColor(cfg, 'color').onChange(function(colorValue) {
          viewer.setModelColorByHexcode(colorValue);
        });

        gui.add(cfg, 'wireframe').onChange(function(val){
          viewer.toggleModelWireframe();
        });

        gui.add(cfg, 'plane').onChange(function(val){
          viewer.togglePlane();
        });

        gui.add(cfg, 'boundingBox').onChange(function(val){
          viewer.toggleBoundingBox();
        });

        gui.add(cfg, 'sphere').onChange(function(val){
          viewer.toggleSphere();
        });

        gui.add(cfg, 'axis').onChange(function(val){
          viewer.toggleAxis();
        });

        gui.add(cfg, 'zoom').onChange(function(val) {
          viewer.zoom = val
        });

        gui.add(cfg, 'material').onChange(function(val){
          viewer.toggleMaterial();
        });

        gui.add(cfg, 'model', cfg.modelSamples).onChange(function(val){
          viewer.load(val,function(){
            viewer.setModelColorByHexcode(cfg.color);
          });
        });

        var obj = { "Reload Viewer":function(){
          viewer.reload();
        }};

                viewer.togglePlane();
                viewer.toggleBoundingBox();
        gui.close();

      });

    }

        wapp "\n</script>\n"
        
        wapp "</head>\n"
        wapp "<body>\n"

        wapp {
                <div class="viewer">
                        <div class="viewer__wrapper">
                                <pre style='color: white;'> Drag&Drop STL file onto here: </pre>

                                <div class="viewer__container" id="stlviewer">
                                </div>
                        </div>
                </div>
        }

        # wapp "\n<ol>\n"
        # wapp-subst {<li><p><a href='%url($B)/fullenv'>Full Environment</a>\n}
        # wapp "\n</ol>\n"

        wapp "</body>\n"
        wapp "</html>\n"
}

puts "
  *** Welcome to the STL-ViewerV0.1 web application ***

        (c) 2018, Johann Oberdorfer,
      Engineering Support | CAD | Software
           www.johann-oberdorfer.eu

  The purpose of this program is merely to get familiar with wapp,
  a web application framework written in tcl.

  The program emulates a local web server and requires
  an up-to-date web browser installation.

  The STL viewer is implemented with jquery.js and three.js.
  
  Credits:
        wapp, web application framework - Copyright D. Richard Hipp 

        jquery.js - Copyright JS Foundation and other contributors,
                    https://js.foundation/
        three.js  - Copyright 2010-2018 three.js authors,
                    https://github.com/mrdoob/three.js/
                https://threejs.org/
    main.js   - Javascript demo code for parsing and
                    rendering STL (ascii and binary) files
                    @tonylukasavage, (https://twitter.com/tonylukasavage)
  Have fun.
"

wapp-start $argv