From 50da5dbb78843fc9867fed39c5894e15806a9660 Mon Sep 17 00:00:00 2001 From: David Botton Date: Thu, 4 Feb 2021 22:48:50 -0500 Subject: [PATCH] Start of demo 3 a lisp IDE --- README.md | 1 + demos/03-demo.lisp | 145 ++++++++++++++++++++++++++++++++ demos/README.md | 1 + static-files/demo/clogicon.png | Bin 0 -> 1773 bytes static-files/demo/clogwicon.png | Bin 0 -> 2136 bytes static-files/demo/frame.html | 46 ++++++++++ 6 files changed, 193 insertions(+) create mode 100644 demos/03-demo.lisp create mode 100644 static-files/demo/clogicon.png create mode 100644 static-files/demo/clogwicon.png create mode 100644 static-files/demo/frame.html diff --git a/README.md b/README.md index 40482de..81b0359 100644 --- a/README.md +++ b/README.md @@ -187,6 +187,7 @@ Demo Summary - 01-demo.lisp - Sparkey the Snake Game - 02-demo.lisp - Chat - Private instant messenger +- 03-demo.lisp - IDE - A very simple common lisp IDE Enhancements underway: diff --git a/demos/03-demo.lisp b/demos/03-demo.lisp new file mode 100644 index 0000000..e766f78 --- /dev/null +++ b/demos/03-demo.lisp @@ -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 + "
+
+ ~A + X + ~A +
+
~A
+
" + 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 + "" + (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 "
+
CLOG
+
The Common Lisp Omnificent GUI
" + :content "

Demo 3
+
(c) 2021 - David Botton

" + :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)) diff --git a/demos/README.md b/demos/README.md index cd4381e..ae6e5d4 100644 --- a/demos/README.md +++ b/demos/README.md @@ -36,3 +36,4 @@ Demo Summary - 01-demo.lisp - Sparkey the Snake Game - 02-demo.lisp - Chat - Private instant messenger +- 03-demo.lisp - IDE - A very simple common lisp IDE diff --git a/static-files/demo/clogicon.png b/static-files/demo/clogicon.png new file mode 100644 index 0000000000000000000000000000000000000000..070e074420434f815c97dd9920b794c9a97834bf GIT binary patch literal 1773 zcmeAS@N?(olHy`uVBq!ia0y~yU{GLSV36TpV_;xlIJ8%Zfq{V~-O<;Pfnj4m_n$;o zkb-27AYTTCDm4a%h86~fUknTk4KElNN(~qoUL`OvSj}Ky5HFasE6|34fuSWe!ZXd+ zmqCkxfq{d8jggIknSp_Uk%5VUfl&y`W@KPslwtsx%*epN5XLACXU8#WK-DlYFtlef zuz>Y4Frge(^kS@*wkH}&M25w;xW@MN(M}mQY z=}BftL`j6Nk5zJhu3lnFep0GlMQ#B|7lTcORYh(=ZfZ%QLPc&)Ua?h$trA#;RbH_b zNLXJ<0j#7X+g2&UH$cHTzbI9~OwT~iK*^3vK|#T$C?(A*$i)q+y(lHkRw<*Tq`*pF zzr4I$uiRKKzbIYb(9+UU-@r)U$Vj&+B~7=uGOr}DLN~8i8Da>`9GBGMNl|99XI@EaQ9)5^Ng~J)xB<9Tpqu4il$n|b)eUnovKW$jkiV@0GAmMZB3v?a zQ}e*SG&M4`(Z?!-uG2X`C%-7TATc==6f|HhNJ8kU!S+NV>@hJlL$(J=2CCCWACwM| z(giqjAfiDoZgyNY`rzaVN~(5T3k~ljFfcGZ_H=O!@!)+s)q90+pv3Y1*E7Q>b`}^f zv^jjFLCMf`!bC>nG_@(5#lprxMuCSWc$_@oG0}a|6g|Vl1p@27fBwF^{Qvr^cHc|B z?L2xSeE;5SaoM%6tJm%=Tm3cuUoP9Rt7m)H^Z#l6?)k=2ur9Rvx1N3X#;jG}m+?Md`=M6X*z1adhSqYM(~1 zF4eQfJEoVM`l8p8yMc%8A@7bnPMKBr@-KhWS!Pz$bdG%o&*{|%OSe=f+UGPz223yJ zxx>Es>f|FkUhZRZlZm@*&m^5F{KZ-G)v*Vfzs@J9nTTCpCvlP2W0(EK?J|W=6#jOw zr8TVe)3$nkEBZlYhKiwG`_=CUc-K_&Ej0Zf(`#KWmF664W?;au&XWHm$K7+2T=O#S zhJ4#ned+D<>TUAvZ|oalH%M(eR9L}(?xf)ht(8Ab!tSw(_L>~q9C>rv(}F*;Q~cb@ z%^%Ai?M|&StnS@6J9E#SH6}6NOoP&ti%%Zle)d=9_K~RP8!R%}^qQn2K3B}=-M!T+ z(aj~6e~p#gg|weT-T$)CsC<7eAX=JbCp z_hGxFyVX|x$j$tVqW|xjAr*V-)^zPVCsrumyPciLdWQYK@Up*_G40+D{M}c+=Iif! zxU#r&Mdz+;Yt}1)`&T->>`Co#v2Qnd+nkaMm6T-LDnNc-DA*LGq*(>IxIwiSrKH&^Wt5Z@Sn2DRmzV368|&p4rRy77T3YHG z80i}s=@zA==@wV!l_XZ^<`pYL41t;Bl3JWxlvz-cnV+WsGB+_PzqG_wNeN_;0t`Uh znOc#Fuqm$?>aFDbTz!y?zM-ChJ~nL?xdm|dq3EheEWoL$Br^?%T_72VHgI4-oM;1b zft7Q9PJU5vL1J>MouLibQOH6FA3;=uqddYTGdDG_I5R)b&e#a52VDZI#z=%lBMW4W zND@dID{>30oQqOH2`nT(KgSMi2U>cw(MMN>W`J*MNn%Q3Nuo<)NvfTZfsvuEfsw9( zNr-{5m5G6sp=A`r1QcaRMu0-jDk!x$Kc^HF-JyAzC3Z$O`q+fgbp>SPm*nTBmK0?s zd*+p-78MkwmL!4`4{94sJ+c_O`Ur#< z?aYk~3=9nP4M8N-Dr9MNt&#Y(B1=QH+USEa4N@ioCrXHDkc*ogmyJF+FN5;69hc!Z z%^n5@W<5_A#}E(Rx6^iKhd7F~mzx(Z4rJyud&Dfw>gt-SBO-FqZ0gk3rq-yN8aIBh z-?*XKbc4lZtxF)w#tlL|NfS7lj)X66ZB4kcXY$wIXV1O2+BrMr{knvwjrr$i8W%r1 z^ZH!Q$}jQ%9&%mD+FE26+pK*5LH=o#wU^vkmn~#Fom9CgM(=#$cKwpL#=IA2zBjGU zR@{F(Fucv{wzk8DG^4{hCaZ;>=3P-aVc#8ZJgr_fOFXAdcY{n`@P8KBX>Pkz7hYZ^ zq+z*5BF29%m+@VSf zroDOjz3=&Wn!{G_5D=KOcu!IM1AR@AK3f z&W1t8rJr8RT7Kzmz)_8iR-HcEs}nBpMU@>|wd9Y9n|9@`$P#l6)sNqnOpR;Qx7fbx zzt7_}P8K>vNw1&SF?4>rvzWh+$zG}@%ta%NJ*-I8JBxYwyVpJ%^3CQ7fd#8iIwySk zYopqRI zVjA+&XdC|n|2JVS&0i0^SO43ZednpG>A|?xxi{wR^jn+u)aY5$BD3U;Zol`0bzV3s zC*9x0!0+_^d-R43hF$-A^;8#bO7D%7Zu!8oc=LbWcl#%(U1+|ryh!Rxj@jh(CKl{{ zXXW3y7N=Lw-xlCL=iVE6?bN%ss}tGRu + + + + + + + + + + + + + + + +
+ +
+ +
+ New + Open... + Save + Save as... +
+
+
+ +
+ Copy + Paste +
+
+
+ +
+ About CLOG Demo 3 +
+
+ ⤢ +
+ + +