mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 10:40:45 -08:00
Start of demo 3 a lisp IDE
This commit is contained in:
David Botton
parent
d9ea589211
commit
50da5dbb78
6 changed files with 193 additions and 0 deletions
|
|
@ -187,6 +187,7 @@ Demo Summary
|
||||||
|
|
||||||
- 01-demo.lisp - Sparkey the Snake Game
|
- 01-demo.lisp - Sparkey the Snake Game
|
||||||
- 02-demo.lisp - Chat - Private instant messenger
|
- 02-demo.lisp - Chat - Private instant messenger
|
||||||
|
- 03-demo.lisp - IDE - A very simple common lisp IDE
|
||||||
|
|
||||||
Enhancements underway:
|
Enhancements underway:
|
||||||
|
|
||||||
|
|
|
||||||
145
demos/03-demo.lisp
Normal file
145
demos/03-demo.lisp
Normal file
|
|
@ -0,0 +1,145 @@
|
||||||
|
(defpackage #:clog-user
|
||||||
|
(:use #:cl #:clog)
|
||||||
|
(:export start-demo))
|
||||||
|
|
||||||
|
(in-package :clog-user)
|
||||||
|
|
||||||
|
(defclass app-data ()
|
||||||
|
((body
|
||||||
|
:accessor body
|
||||||
|
:documentation "Store top level access on new window")
|
||||||
|
(drag-mutex
|
||||||
|
:reader drag-mutex
|
||||||
|
:initform (bordeaux-threads:make-lock)
|
||||||
|
:documentation "Serialize access to the on-mouse-down event.")
|
||||||
|
(in-drag
|
||||||
|
:accessor in-drag-p
|
||||||
|
:initform nil
|
||||||
|
:documentation "Ensure only one box is dragged at a time.")
|
||||||
|
(drag-x
|
||||||
|
:accessor drag-x
|
||||||
|
:documentation "The location of the left side of the box relative to mouse during drag.")
|
||||||
|
(drag-y
|
||||||
|
:accessor drag-y
|
||||||
|
:documentation "The location of the top of the box relative to mouse during drag.")))
|
||||||
|
|
||||||
|
(defun on-mouse-down (obj data)
|
||||||
|
(let ((app (connection-data-item obj "app-data")))
|
||||||
|
(bordeaux-threads:with-lock-held ((drag-mutex app))
|
||||||
|
(setf (z-index obj) 1)
|
||||||
|
(unless (in-drag-p app)
|
||||||
|
(setf (in-drag-p app) t)
|
||||||
|
(let* ((mouse-x (getf data ':screen-x))
|
||||||
|
(mouse-y (getf data ':screen-y))
|
||||||
|
(obj-top (parse-integer (top obj) :junk-allowed t))
|
||||||
|
(obj-left (parse-integer (left obj) :junk-allowed t)))
|
||||||
|
(setf (drag-x app) (- mouse-x obj-left))
|
||||||
|
(setf (drag-y app) (- mouse-y obj-top))
|
||||||
|
(if (eq (getf data ':event-type) :touch)
|
||||||
|
(progn
|
||||||
|
(set-on-touch-move obj 'on-mouse-move)
|
||||||
|
(set-on-touch-end obj 'stop-obj-grab)
|
||||||
|
(set-on-touch-cancel obj 'on-mouse-leave))
|
||||||
|
(progn
|
||||||
|
(set-on-mouse-move obj 'on-mouse-move)
|
||||||
|
(set-on-mouse-up obj 'stop-obj-grab)
|
||||||
|
(set-on-mouse-leave obj 'on-mouse-leave))))))))
|
||||||
|
|
||||||
|
(defun on-mouse-move (obj data)
|
||||||
|
(let* ((app (connection-data-item obj "app-data"))
|
||||||
|
(x (getf data ':screen-x))
|
||||||
|
(y (getf data ':screen-y)))
|
||||||
|
(setf (top obj) (format nil "~Apx" (- y (drag-y app))))
|
||||||
|
(setf (left obj) (format nil "~Apx" (- x (drag-x app))))))
|
||||||
|
|
||||||
|
(defun on-mouse-leave (obj)
|
||||||
|
(let ((app (connection-data-item obj "app-data")))
|
||||||
|
(setf (in-drag-p app) nil)
|
||||||
|
(set-on-touch-move obj nil)
|
||||||
|
(set-on-touch-end obj nil)
|
||||||
|
(set-on-touch-cancel obj nil)
|
||||||
|
(set-on-mouse-move obj nil)
|
||||||
|
(set-on-mouse-up obj nil)
|
||||||
|
(set-on-mouse-leave obj nil)))
|
||||||
|
|
||||||
|
(defun stop-obj-grab (obj data)
|
||||||
|
(on-mouse-move obj data)
|
||||||
|
(on-mouse-leave obj))
|
||||||
|
|
||||||
|
(defgeneric create-window (clog-obj title
|
||||||
|
&key html-id content left top width height)
|
||||||
|
(:documentation "Create an html-window"))
|
||||||
|
|
||||||
|
(defmethod create-window ((obj clog-obj) title &key
|
||||||
|
(html-id nil)
|
||||||
|
(top-bar "")
|
||||||
|
(content "")
|
||||||
|
(left 60)
|
||||||
|
(top 60)
|
||||||
|
(width 400)
|
||||||
|
(height 300))
|
||||||
|
(unless html-id
|
||||||
|
(setf html-id (clog-connection:generate-id)))
|
||||||
|
|
||||||
|
(let* ((app (connection-data-item obj "app-data"))
|
||||||
|
(win (create-child (body app)
|
||||||
|
(format nil
|
||||||
|
"<div style='position:absolute;top:~Apx;left:~Apx;width:~Apx;height:~Apx;'
|
||||||
|
class='w3-card-4 w3-white w3-border'>
|
||||||
|
<div class='w3-container w3-black' style='cursor: move;'>
|
||||||
|
<span id='~A-title'>~A</span>
|
||||||
|
<span id='~A-close' class='w3-right' style='cursor: pointer;'>X</span>
|
||||||
|
~A
|
||||||
|
</div>
|
||||||
|
<div id='~A-body' style='right:0;height:100%;margin: 0 auto;'>~A</div>
|
||||||
|
</div>"
|
||||||
|
top left width height html-id title html-id top-bar html-id content)
|
||||||
|
:html-id html-id)))
|
||||||
|
(set-on-click (attach-as-child obj (format nil "~A-close" html-id))
|
||||||
|
(lambda (obj)
|
||||||
|
(setf (hiddenp win) t)))
|
||||||
|
win))
|
||||||
|
|
||||||
|
(defun do-ide-file-new (obj)
|
||||||
|
(let* ((app (connection-data-item obj "app-data"))
|
||||||
|
(win (create-window obj "New window"
|
||||||
|
:left (random 600)
|
||||||
|
:top (+ 40 (random 400)))))
|
||||||
|
(create-child obj
|
||||||
|
(format nil
|
||||||
|
"<script>
|
||||||
|
var editor = ace.edit('~A-body');
|
||||||
|
editor.setTheme('ace/theme/xcode');
|
||||||
|
editor.session.setMode('ace/mode/lisp');
|
||||||
|
</script>"
|
||||||
|
(html-id win)))
|
||||||
|
(set-on-touch-start win 'on-mouse-down)
|
||||||
|
(set-on-mouse-down win 'on-mouse-down)))
|
||||||
|
|
||||||
|
(defun do-ide-help-about (obj)
|
||||||
|
(let* ((app (connection-data-item obj "app-data"))
|
||||||
|
(about (create-window (body app) "About"
|
||||||
|
:top-bar "<center><img src='/demo/clogwicon.png'></center>
|
||||||
|
<center>CLOG</center>
|
||||||
|
<center>The Common Lisp Omnificent GUI</center>"
|
||||||
|
:content "<p><center>Demo 3</center>
|
||||||
|
<center>(c) 2021 - David Botton</center></p>"
|
||||||
|
:left (- (/ (width (body app)) 2) 100)
|
||||||
|
:width 200
|
||||||
|
:height 200)))
|
||||||
|
(set-on-touch-start about 'on-mouse-down)
|
||||||
|
(set-on-mouse-down about 'on-mouse-down)))
|
||||||
|
|
||||||
|
(defun on-new-window (body)
|
||||||
|
(let ((app (make-instance 'app-data)))
|
||||||
|
(setf (connection-data-item body "app-data") app)
|
||||||
|
(setf (body app) body)
|
||||||
|
(set-on-click (attach-as-child body "ide-file-new") #'do-ide-file-new)
|
||||||
|
(set-on-click (attach-as-child body "ide-help-about") #'do-ide-help-about)
|
||||||
|
(set-on-click (attach-as-child body "ide-logo") #'do-ide-help-about)
|
||||||
|
(run body)))
|
||||||
|
|
||||||
|
(defun start-demo ()
|
||||||
|
"Start demo."
|
||||||
|
(initialize #'on-new-window :boot-file "/demo/frame.html")
|
||||||
|
(open-browser))
|
||||||
|
|
@ -36,3 +36,4 @@ Demo Summary
|
||||||
|
|
||||||
- 01-demo.lisp - Sparkey the Snake Game
|
- 01-demo.lisp - Sparkey the Snake Game
|
||||||
- 02-demo.lisp - Chat - Private instant messenger
|
- 02-demo.lisp - Chat - Private instant messenger
|
||||||
|
- 03-demo.lisp - IDE - A very simple common lisp IDE
|
||||||
|
|
|
||||||
BIN
static-files/demo/clogicon.png
Normal file
BIN
static-files/demo/clogicon.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
static-files/demo/clogwicon.png
Normal file
BIN
static-files/demo/clogwicon.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.1 KiB |
46
static-files/demo/frame.html
Normal file
46
static-files/demo/frame.html
Normal file
|
|
@ -0,0 +1,46 @@
|
||||||
|
<!doctype HTML>
|
||||||
|
<HTML>
|
||||||
|
<HEAD>
|
||||||
|
<meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate" />
|
||||||
|
<meta http-equiv="Pragma" content="no-cache" />
|
||||||
|
<meta http-equiv="Expires" content="0" />
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||||
|
<script src="/js/jquery.min.js" type="text/javascript"></script>
|
||||||
|
<script>var clog_debug = true;</script>
|
||||||
|
<script src="/js/boot.js" type="text/javascript"></script>
|
||||||
|
<link rel="stylesheet" href="https://www.w3schools.com/w3css/4/w3.css">
|
||||||
|
<script src="https://pagecdn.io/lib/ace/1.4.12/ace.js" type="text/javascript" charset="utf-8"></script>
|
||||||
|
</HEAD>
|
||||||
|
|
||||||
|
<BODY class="w3-teal">
|
||||||
|
<div class="w3-bar w3-black w3-card-4">
|
||||||
|
<button id='ide-logo' class="w3-button w3-bar-item">
|
||||||
|
<img height=22 src="/demo/clogwicon.png"></button>
|
||||||
|
<div class="w3-dropdown-hover">
|
||||||
|
<button class="w3-button">File</button>
|
||||||
|
<div class="w3-dropdown-content w3-bar-block w3-card-4">
|
||||||
|
<span id='ide-file-new' class="w3-bar-item w3-button">New</span>
|
||||||
|
<span class="w3-bar-item w3-button">Open...</span>
|
||||||
|
<span class="w3-bar-item w3-button">Save</span>
|
||||||
|
<span class="w3-bar-item w3-button">Save as...</span>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
<div class="w3-dropdown-hover">
|
||||||
|
<button class="w3-button">Edit</button>
|
||||||
|
<div class="w3-dropdown-content w3-bar-block w3-card-4">
|
||||||
|
<span class="w3-bar-item w3-button">Copy</span>
|
||||||
|
<span class="w3-bar-item w3-button">Paste</span>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
<div class="w3-dropdown-hover">
|
||||||
|
<button class="w3-button">Help</button>
|
||||||
|
<div class="w3-dropdown-content w3-bar-block w3-card-4">
|
||||||
|
<span id="ide-help-about" class="w3-bar-item w3-button">About CLOG Demo 3</span>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
<span class="w3-bar-item w3-right" onClick="documentElement.requestFullscreen()">⤢</span>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</BODY>
|
||||||
|
</HTML>
|
||||||
Loading…
Add table
Add a link
Reference in a new issue