luv

Workshop wiki

inventory.lisp

mcclim/inventory.lisp

system luvcraft/mcclim · 63 definitions · on GitHub

A modal McCLIM inventory presented over the live luvcraft canvas.

in-package#:mcluv
defconstant+inventory-grid-left+166
defparameter*inventory-categories*'
:all"All blocks"
:natural"Natural"
:building"Building"
:luminous"Luminous"
defparameter*inventory-panel-ink*
make-rgb-color0.200.200.18
defparameter*inventory-well-ink*
make-rgb-color0.1050.1050.095
defparameter*inventory-face-ink*
make-rgb-color0.310.300.27
defparameter*inventory-light-edge*
make-rgb-color0.520.500.44
defparameter*inventory-dark-edge*
make-rgb-color0.0550.0550.05
defparameter*inventory-text-ink*
make-rgb-color0.910.890.82
defparameter*inventory-muted-ink*
make-rgb-color0.650.650.59
defparameter*inventory-accent-ink*
make-rgb-color0.580.780.54
defclassinventory-pane
application-pane
define-application-frameluvcraft-inventory
session:initarg:session:readerinventory-session
visible-state:initformnil:accessorinventory-visible-state
category:initform:all:accessorinventory-category
page:initform0:accessorinventory-page
atlas:initform:readerinventory-atlas
:menu-barnil
:panes
inventory
make-pane'inventory-pane:default-text-style
make-text-style:serifnil:normal
:layouts
default
horizontallyinventory
defundraw-inventory-bevel
streamlefttoprightbottom&keyrecessed-p

Draw one deliberately old-fashioned raised or recessed CLIM panel.

draw-rectangle*streamlefttoprightbottom:inkink
let
draw-line*streamlefttoprighttop:inktop-left:line-thickness2
draw-line*streamlefttopleftbottom:inktop-left:line-thickness2
draw-line*streamleftbottomrightbottom:inkbottom-right:line-thickness2
draw-line*streamrighttoprightbottom:inkbottom-right:line-thickness2
defuninventory-block-preview-tile
block
let
tiles
luvcraft:block-kind-face-tilesblock
or
getftiles:top
getftiles:all
getftiles:side
defunpacked-inventory-ink
word
make-rgb-color
/
ldb
byte80
word
255.0
/
ldb
byte88
word
255.0
/
ldb
byte816
word
255.0
defundraw-inventory-block-tile
streamatlasblocklefttop&key

Paint block as an isometric cube, sized as scale sixteenths used to be.

The flat top tile said what a material looked like; the cube says what it is. atlas is no longer read here -- block-icon-pattern keeps its own -- but it stays in the lambda list because the inventory frame owns one and the callers all have it to hand.

declare
ignoreatlas
draw-block-iconstreamblocklefttop
defuninventory-entry-label
entry
string-upcase
symbol-name
luvcraft:block-kind-name
luvcraft:block-inventory-entry-blockentry
defuninventory-entry-quantity-label
entry

How many there are, as a count or as the mark for no limit.

A creative inventory is mostly unlimited stacks, and spelling that out in every cell makes the word louder than the block it is about.

alexandria:if-let
quantity
luvcraft:block-inventory-entry-quantityentry
formatnil"~D"quantity
"∞"
defuninventory-category-block-p
categoryblock
or
eqcategory:all
membercategory
luvcraft:block-kind-categoriesblock
defuninventory-filtered-entries
remove-if-not
lambda
entry
inventory-category-block-p
inventory-categoryframe
luvcraft:block-inventory-entry-blockentry
luvcraft:block-inventory-entries
luvcraft:luvcraft-session-inventory
inventory-sessionframe
defuninventory-visible-state-for
let
session
inventory-sessionframe
list
inventory-categoryframe
inventory-pageframe
luvcraft:luvcraft-session-selected-blocksession
loopforentryin
luvcraft:block-inventory-entries
luvcraft:luvcraft-session-inventorysession
collect
listentry
luvcraft:block-inventory-entry-quantityentry
defundraw-inventory-category
framepanecategorylabelindex
let*
top
+50
*index39
selected-p
eqcategory
inventory-categoryframe
progn
draw-inventory-bevelpane16top150
+top34
:ink
ifselected-p
make-rgb-color0.360.350.30
*inventory-panel-ink*
:recessed-pselected-p
draw-rectangle*pane25
+top9
40
+top24
:ink
ecasecategory
:all
make-rgb-color0.720.560.24
:natural
make-rgb-color0.200.500.18
:building
make-rgb-color0.490.470.42
:luminous
make-rgb-color0.180.720.74
draw-text*panelabel49
+top17
:align-y:center:text-size14:ink
ifselected-p+white+*inventory-text-ink*
defundraw-inventory-page-controls
framepane
let
draw-inventory-bevelpane1661220043:ink*inventory-panel-ink*:recessed-pt
draw-inventory-bevelpane6161265043:ink*inventory-panel-ink*:recessed-pt
draw-text*pane"‹"18327:align-x:center:align-y:center:text-size20:ink
draw-text*pane"›"63327:align-x:center:align-y:center:text-size20:ink
draw-text*pane
formatnil"Inventory · ~D / ~D"count
40827:align-x:center:align-y:center:text-size17:ink*inventory-text-ink*
defundraw-inventory-entry
framepaneentryindexlefttopwidthheight
let*
block
luvcraft:block-inventory-entry-blockentry
selected-p
eqblock
luvcraft:luvcraft-session-selected-block
inventory-sessionframe
progn
draw-inventory-bevelpanelefttop
+leftwidth
:ink
ifselected-p
make-rgb-color0.390.390.34
*inventory-face-ink*
:recessed-pt
whenselected-p
draw-rectangle*pane
+left3
+top3
-
+leftwidth
3
:ink*inventory-accent-ink*:fillednil:line-thickness2
draw-inventory-block-tilepane
inventory-atlasframe
block
+left
/2.0
+top10
:scale3
draw-text*pane
formatnil"~D"
1+index
+left9
+top10
:text-size11:ink*inventory-text-ink*
draw-text*pane
-
+leftwidth
8
:align-x:right:align-y:bottom:text-size12:ink*inventory-muted-ink*
defundraw-inventory-quickbar
framepaneentries
draw-text*pane"Quickbar"+inventory-grid-left+242:align-y:center:text-size14:ink*inventory-text-ink*
let
loopforentryinentriesforindexfrom0forblock=
luvcraft:block-inventory-entry-blockentry
forleft=forselected-p=
eqblock
luvcraft:luvcraft-session-selected-block
inventory-sessionframe
do
draw-inventory-bevelpaneleft+inventory-quickbar-top+
+leftslot-width
+inventory-quickbar-bottom+:ink
ifselected-p
make-rgb-color0.400.400.35
*inventory-face-ink*
:recessed-pt
whenselected-p
draw-rectangle*pane
+left2
-
+leftslot-width
2
:fillednil:line-thickness2:ink*inventory-accent-ink*
draw-inventory-block-tilepane
inventory-atlasframe
block
+left
/
-slot-width32
2
:scale2
draw-text*pane
formatnil"~D"
1+index
+left5
:text-size9:ink+white+
defgenericinventory-detail-rows
blockentry
:documentation

The (label . VALUE) rows the inspector prints for block held as entry.

:method
list
cons"Type""Block"
cons"Light opacity"
cons"Light emission"
cons"Surface emission"
defuninventory-clipped-label
textlimit
if
andtext
>
lengthtext
limit
concatenate'string
subseqtext0
1-limit
"…"
ortext"—"
defmethodinventory-detail-rows

A film is its video: what it is called, who put it up, how long it runs.

let
duration
luvcraft:film-durationfilm
list
cons"Type""Film"
cons"Title"
inventory-clipped-label
luvcraft:film-titlefilm
17
cons"By"
inventory-clipped-label
luvcraft:film-uploaderfilm
22
cons"Runs"
ifduration
formatnil"~D:~2,'0D"
"—"
defundraw-inventory-details
framepaneselectedentry
draw-text*pane"Item Inspector"66831:align-y:center:text-size14:ink*inventory-text-ink*
draw-inventory-block-tilepane
inventory-atlasframe
selected67458:scale3
draw-text*pane73070:align-y:center:text-size15:ink+white+
draw-text*pane
formatnil"luvcraft:~(~A~)"
luvcraft:block-kind-nameselected
73092:align-y:center:text-size10:ink*inventory-muted-ink*
draw-line*pane668119822119:ink*inventory-dark-edge*
draw-text*pane"Details"668138:align-y:center:text-size13:ink*inventory-text-ink*
loopfor
label.value
inforyfrom162by24do
draw-text*panelabel668y:align-y:center:text-size10:ink*inventory-muted-ink*
draw-text*pane
formatnil"~A"value
820y:align-x:right:align-y:center:text-size10:ink*inventory-text-ink*
draw-line*pane668294822294:ink*inventory-dark-edge*
draw-text*pane"Presentation"668313:align-y:center:text-size12:ink*inventory-text-ink*
draw-text*pane
formatnil"#<BLOCK-KIND ~(~A~)>"
luvcraft:block-kind-nameselected
668336:align-y:center:text-size10:ink*inventory-accent-ink*
defmethodhandle-repaint
region
declare
ignoreregion
let*
frame
pane-framepane
session
inventory-sessionframe
inventory
luvcraft:luvcraft-session-inventorysession
all-entries
luvcraft:block-inventory-entriesinventory
selected
luvcraft:luvcraft-session-selected-blocksession
selected-entry
with-bounding-rectangle*
lefttoprightbottom
pane
with-sheet-medium
mediumpane
draw-analytic-rounded-rectangle*mediumlefttoprightbottom:radius7:ink
make-linear-gradient0top0bottom
make-rgb-color0.250.250.23
make-rgb-color0.120.120.11
draw-rectangle*pane33
-right3
-bottom3
:fillednil:line-thickness2:ink*inventory-light-edge*
draw-text*pane"Categories"1630:align-y:center:text-size13:ink*inventory-text-ink*
loopfor
categorylabel
in*inventory-categories*forindexfrom0do
loopforentryinentriesforindexfrom0forcolumn=forrow=fornumber=
positionentryall-entries:test#'eq
do
draw-inventory-entryframepaneentrynumber
++inventory-grid-left+
*columncell-width
4
++inventory-grid-top+
*rowcell-height
4
-cell-width8
-cell-height8
draw-inventory-quickbarframepanequickbar-entries
whenselected-entry
draw-inventory-detailsframepaneselectedselected-entry
draw-inventory-bevelpane8366832404:ink*inventory-panel-ink*:recessed-pt
draw-text*pane"Mode: Creative"18385:align-y:center:text-size11:ink*inventory-text-ink*
draw-text*pane
formatnil"Slots: ~D"
lengthall-entries
300385:align-y:center:text-size11:ink*inventory-text-ink*
draw-text*pane
formatnil"Selected: ~(~A~)"
luvcraft:block-kind-nameselected
520385:align-y:center:text-size11:ink*inventory-text-ink*
draw-inventory-bevelpane8410832458:ink*inventory-well-ink*:recessed-pt
draw-text*pane"Presentation>"18434:align-y:center:text-size11:ink*inventory-accent-ink*
draw-text*pane
formatnil"#<BLOCK-INVENTORY-ENTRY ~(~A~)>"
luvcraft:block-kind-nameselected
150434:align-y:center:text-size11:ink*inventory-text-ink*
draw-text*pane"Click: select Category: filter I / Esc: close"18480:align-y:center:text-size11:ink*inventory-text-ink*
defunrepaint-inventory
let
mirror
sheet-direct-mirror
frame-top-level-sheetframe
check-typemirrorluv-gpu-mirror
setf
inventory-visible-stateframe
frame
defclassluvcraft-inventory-overlay
visible-p:initformt:accessorinventory-overlay-visible-p
defmethodluvcraft:encode-luvcraft-overlay:around
sessionpasssurface-texture

Hide the redundant HUD bar while the full inventory owns modal focus.

if
typep
luvcraft:luvcraft-session-modal-focussession
'luvcraft-inventory-overlay
hotbar
call-next-method
defmethodluvcraft:luvcraft-overlay-stage
declare
ignoreoverlay
:hud
defuninventory-screen-state
overlay
let*
source-size
viewport-size
multiple-value-list
luv:canvas-logical-size
luvcraft:luvcraft-session-canvas
widget-overlay-sessionoverlay
source-width
firstsource-size
source-height
secondsource-size
viewport-width
firstviewport-size
viewport-height
secondviewport-size
scale
min1.0
/
-viewport-width36.0
source-width
/
-viewport-height36.0
source-height
half-width
/
*source-widthscale
viewport-width
half-height
/
*source-heightscale
viewport-height
make-array12:element-type'single-float:initial-contents
mapcar
lambda
value
coercevalue'single-float
list0.00.00.01.0half-width0.00.00.00.0half-height0.00.0
luv:zdefmethod
luvcraft:encode-luvcraft-overlay:zone:inventory/encode
sessionpasssurface-texture
declare
ignorepass
when
inventory-overlay-visible-poverlay
prepare-direct-widget-overlayoverlaysessionsurface-texture
overlay
luv:zdefmethod
luvcraft:refresh-luvcraft-overlay:zone:inventory/refresh
declare
ignoresession
when
inventory-overlay-visible-poverlay
let
frame
widget-overlay-frameoverlay
overlay
defmethodluvcraft:handle-luvcraft-overlay-event
declare
ignorecanvas
when
inventory-overlay-visible-poverlay
alexandria:when-let
uv
luvcraft-widget-texture-coordinateoverlay
luv:canvas-pointer-event-xevent
luv:canvas-pointer-event-yevent
when
and
eq:left
luv:canvas-pointer-event-buttonevent
let*
frame
widget-overlay-frameoverlay
inventory
luvcraft:luvcraft-session-inventorysession
all-entries
luvcraft:block-inventory-entriesinventory
page-direction
cond
category
setf
inventory-categoryframe
category
inventory-pageframe
0
page-direction
setf
inventory-pageframe
max0
min
+
inventory-pageframe
page-direction
t
let*
entries
ifvisiblequickbar-entries
entry
andslot
nthslotentries
whenentry
let
number
positionentryall-entries:test#'eq
t
defmethodluvcraft:handle-luvcraft-focus-event

Escape leaves, and so does another I: the key which opened the view is the key which puts it away, since while it is open it owns every key.

if
or
eq:escape
luv:canvas-key-event-key-nameevent
and
eq:i
luv:canvas-key-event-key-nameevent
not
luv:canvas-key-event-repeat-pevent
call-next-method
defmethodluvcraft:luvcraft-focus-left
declare
ignoresession
setf
inventory-overlay-visible-poverlay
nil
overlay
defunopen-luvcraft-inventory
session&key
title"luvcraft inventory"

Create, attach, and focus session's modal McCLIM inventory view.

alexandria:if-let
overlay
find-if
lambda
candidate
luvcraft:luvcraft-session-overlayssession
progn
setf
inventory-overlay-visible-poverlay
t
overlay
let*
port
find-port:server-path'
:luv-gpu
manager
or
first
climi::frame-managersport
make-instance'luv-frame-manager:portport
frame
let
*embedded-mirror-target*
luvcraft:luvcraft-session-canvassession
*embedded-mirror-context*
luvcraft::luvcraft-session-contextsession
*embedded-mirror-device*
luvcraft::luvcraft-session-devicesession
make-application-frame'luvcraft-inventory:frame-managermanager:enablet:sessionsession
setf
frame-pretty-nameframe
title
inventory-visible-stateframe
let*
mirror
sheet-direct-mirror
frame-top-level-sheetframe
overlay
make-instance'luvcraft-inventory-overlay:sessionsession:frameframe:mirrormirror
setf
mirror-compositormirror
overlay
when
typepmirror'luv-gpu-mirror
overlay
defunclose-luvcraft-inventory
overlay

Close an open-luvcraft-inventory overlay.

let
session
widget-overlay-sessionoverlay
setf
inventory-overlay-visible-poverlay
nil
when
eqoverlay
luvcraft:luvcraft-session-modal-focussession
nil
defmethodluvcraft:toggle-luvcraft-inventory
alexandria:if-let
overlay
find-if
lambda
candidate
luvcraft:luvcraft-session-overlayssession
if
inventory-overlay-visible-poverlay
defmethodluvcraft:attach-luvcraft-hud:around

Build the durable inventory pane before the game window is published. Opening it later is then only focus/visibility state, with no shader or glyph-atlas compilation on the frame thread. This is an AROUND method so application adapters can independently own :AFTER attachment hooks; CLOS replaces, rather than accumulates, identical qualified coordinates.

multiple-value-prog1
call-next-method