mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-05 18:20:36 -08:00
Code Issues Projects Releases Wiki Activity

improved placer acuracy

Browse source
This commit is contained in:
David Botton 2024-07-23 23:49:36 -04:00
parent 17b3eb5d85
commit ec93e87deb
1 changed files with 8 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

16
tools/clog-builder-panels.lisp
View file

@ -271,19 +271,19 @@ return t on success"
(shift (getf data :shift-key)))
(cond ((equal key "ArrowUp")
(if shift
(set-geometry control :height (1- (height control)))
(set-geometry control :height (1- (client-height control)))
(set-geometry control :top (1- (position-top control)))))
((equal key "ArrowDown")
(if shift
(set-geometry control :height (+ (height control) 2))
(set-geometry control :height (+ (client-height control) 2))
(set-geometry control :top (+ (position-top control) 2))))
((equal key "ArrowRight")
(if shift
(set-geometry control :width (+ (width control) 2))
(set-geometry control :width (+ (client-width control) 2))
(set-geometry control :left (+ (position-left control) 2))))
((equal key "ArrowLeft")
(if shift
(set-geometry control :width (1- (width control)))
(set-geometry control :width (1- (client-width control)))
(set-geometry control :left (1- (position-left control)))))
((and (equal key "c")
(or meta ctrl))
@ -377,12 +377,12 @@ return t on success"
(on-populate-control-properties-win content :win win)
(on-populate-control-list-win content :win win))
((and last
(or (> (getf data :x) (- (width control) 5))
(> (getf data :y) (- (height control) 5))))
(or (> (getf data :x) (- (client-width control) 5))
(> (getf data :y) (- (client-height control) 5))))
(setf mv-state :size)
(setf (background-color placer) (rgba 0 255 0 0.10))
(setf last-w (width control))
(setf last-h (height control))
(setf last-w (client-width control))
(setf last-h (client-height control))
(setf touch-x (getf data :screen-x))
(setf touch-y (getf data :screen-y)))
(last