luv

Workshop wiki

widget-lab.lisp

mcclim/widget-lab.lisp

system luv/mcclim · 10 definitions · on GitHub

in-package#:mcluv

A tiny real-gadget proof for the canvas input bridge. It deliberately enables the frame without entering a conventional backend event loop: luv's native canvas thread already delivers portable pointer events to McCLIM's distributor.

defclassrelief-button-pane
climi::push-button-pane
defclassrelief-toggle-button-pane
climi::toggle-button-pane
defunrepaint-relief-button
panepressed-pcolor
with-bounding-rectangle*
lefttoprightbottom
pane
let*
inset8
offset
ifpressed-p20
height
ifpressed-p-2.07.0
center-x
/
+leftright
2
center-y
+offset
/
+topbottom
2
draw-rectangle*panelefttoprightbottom:ink
make-rgb-color0.100.1150.13
with-sheet-medium
mediumpane
draw-analytic-rounded-rectangle*medium
+leftinset
+topinsetoffset
-rightinset
-bottominset
-offset
:radius14:ink
draw-text*pane
gadget-labelpane
center-xcenter-y:align-x:center:align-y:center:ink
make-rgb-color0.960.970.98
defmethodhandle-repaint
declare
ignoreregion
with-slots
climi::armedclimi::pressedp
pane
repaint-relief-buttonpane
andclimi::armedclimi::pressedp
make-rgb-color0.200.480.78
defmethodhandle-repaint
declare
ignoreregion
with-slots
climi::armedclimi::pressedp
pane
repaint-relief-buttonpane
andclimi::armedclimi::pressedp
if
gadget-valuepane
make-rgb-color0.200.680.48
make-rgb-color0.270.310.36
define-application-framewidget-lab
click-count:initform0:accessorwidget-lab-click-count
toggle-value:initformnil:accessorwidget-lab-toggle-value
:menu-barnil
:panes
clicker
make-pane'relief-button-pane:label"Click me":activate-callback'activate-widget-lab-clicker
toggle
make-pane'relief-toggle-button-pane:label"Toggle is off":valuenil:value-changed-callback'change-widget-lab-toggle
:layouts
default
vertically
:width360:height180:spacing18
clickertoggle
defunactivate-widget-lab-clicker
gadget
let
frame
gadget-clientgadget
incf
widget-lab-click-countframe
setf
gadget-labelgadget
formatnil"Clicked ~D time~:P"
widget-lab-click-countframe
defunchange-widget-lab-toggle
gadgetvalue
let
frame
gadget-clientgadget
setf
widget-lab-toggle-valueframe
value
gadget-labelgadget
ifvalue"Toggle is on""Toggle is off"

The gadget's value repaint is requested before McCLIM invokes this callback, so ask for another after changing its label.

dispatch-repaintgadget+everywhere+
defunopen-widget-lab
&key
server-path'
:luv-gpu
title"McCLIM widgets on luv"
targetcontextdevice

Create, adopt, and enable a tiny interactive McCLIM gadget frame.

when
andtarget
error":TARGET requires the shared :CONTEXT and :DEVICE."
let*
port
find-port:server-pathserver-path

McCLIM main currently calls FIRST on the newly constructed manager when a port has no managers yet. Spell out that tiny bootstrap here until FIND-FRAME-MANAGER's empty-port branch is fixed upstream.

manager
or
first
climi::frame-managersport
make-instance'luv-frame-manager:portport
frame
let
make-application-frame'widget-lab:frame-managermanager:enablet
setf
frame-pretty-nameframe
title
alexandria:when-let*
sheet
frame-top-level-sheetframe
mirror
sheet-direct-mirrorsheet
when
typepmirror'luv-gpu-mirror

MAKE-APPLICATION-FRAME performs ordinary pane repaints after the mirror is enabled. Publish once more when the complete pane tree and all of its media exist, so no construction-time partial frame wins.

frame
defunclose-widget-lab

Destroy an open-widget-lab frame and its luv canvas.

check-typeframewidget-lab
unless
eq:disowned
frame-stateframe
destroy-frameframe
nil