luv

Workshop wiki

status-bar-tests.lisp

mcclim/status-bar-tests.lisp

system luv/mcclim/test · 21 definitions · on GitHub

in-package#:mcluv.tests
defclassstatus-bar-test-owner
samples:initform0:accessorstatus-bar-test-samples
defmethodluv.lobby:lobby-client-summary
declare
ignoreclient
values:online7nil42
defmethodmcluv:status-bar-channels-for
declare
ignoreowner
'
:game-field
defmethodmcluv:status-bar-application-name
declare
ignoreowner

test game

defmethodmcluv:status-bar-source-root
declare
ignoreowner
nil
defmethodmcluv:status-bar-channels-for
append
call-next-method
'
:game-field
defmethodmcluv:status-bar-channel-label
channel
eql:game-field
declare
ignorechannelowner

game

defmethodmcluv:status-bar-channel-value
channel
eql:game-field
bar
declare
ignorechannelbar
incf
status-bar-test-samplesowner

ready

defunmake-status-bar-test-frame
&optional
owner
make-instance'status-bar-test-owner
logical-width900
clim:make-application-frame'mcluv:status-bar:ownerowner:logical-widthlogical-width:worktreenil
defteststatus-bar-composes-base-and-game-defined-clos-channels
let*
setf
mcluv::status-bar-last-sample-ticksbar
0
ok
equal'
:application:pid:fps:heap:lobby:worktree:game-field
mapcar#'mcluv:status-bar-field-channel
mcluv:status-bar-visible-fieldsbar
ok
string="test game"
mcluv:status-bar-field-value
first
mcluv:status-bar-visible-fieldsbar
ok
string="ready"
mcluv:status-bar-field-value
car
last
mcluv:status-bar-visible-fieldsbar
defteststatus-bar-sampling-and-semantic-repaint-are-throttled
let*
owner
ticksinternal-time-units-per-second
setf
mcluv::status-bar-last-sample-ticksbar
0
let
revision
mcluv::status-bar-revisionbar
ok
=1
status-bar-test-samplesowner
loopforframefrom1to100do
ok
=1
status-bar-test-samplesowner
ok
=revision
mcluv::status-bar-revisionbar

A later sample runs once, but identical semantic fields do not dirty or revise the retained stream.

ok
=2
status-bar-test-samplesowner
ok
=revision
mcluv::status-bar-revisionbar
defteststatic-status-bar-prepares-live-shader-revisions
let
setf
mcluv::status-bar-dirty-pbar
nil
multiple-value-bind
proberevision
ok
equal
listrevision
current-revision-preparation-probe-revisionsprobe
defteststatus-bar-drops-trailing-fields-to-fit-a-narrow-window
let
setf
mcluv:status-bar-visible-fieldsbar
list
mcluv::make-status-bar-field:channel:application:labelnil:value"LUFT"
mcluv::make-status-bar-field:channel:pid:label"pid":value"123"
mcluv::make-status-bar-field:channel:fps:label"fps":value"60"
let*
first"LUFT"
first-two"LUFT · pid 123"
first-two-width
setf
mcluv:status-bar-logical-widthbar
+pad
ceilingfirst-two-width
ok
string=first-two
ok
<=
-
mcluv:status-bar-logical-widthbar
pad

Fitting is a stable prefix policy: narrower bars neither rescale text nor skip ahead to a later, shorter field.

setf
mcluv:status-bar-logical-widthbar
+pad
floor
1-first-two-width
ok
setf
mcluv:status-bar-logical-widthbar
+pad
max0
floor
1-first-width
defteststatus-bar-fits-wide-glyphs-by-shaped-advance
let*
text"WWWWWWWWWWWW"
old-eight-pixel-estimate
*8
lengthtext
available-widthold-eight-pixel-estimate
setf
mcluv:status-bar-visible-fieldsbar
list
mcluv::make-status-bar-field:channel:wide:labelnil:valuetext
mcluv:status-bar-logical-widthbar
ok
<=old-eight-pixel-estimateavailable-width
ok
>actual-widthavailable-width
defteststatus-bar-samples-only-bounded-summary-data
let*
ok
string="online 7"
let
text
mcluv::bounded-status-bar-text
make-string10000:initial-element#\x
ok
string="..."text:start2
-
lengthtext
3
let*
owned
copy-seq"ready"
setf
charowned0
#\X
ok
string="ready"snapshot
defteststatus-bar-is-top-aligned-and-native-destination-resolution
let*
logical'
900600
drawable'
18001200
half-width
arefstate4
half-height
arefstate9
center-y
arefstate1
ok
<
abs
-900.0
*half-width
firstlogical
1.0e-4
ok
<
abs
-28.0
*half-height
secondlogical
1.0e-4
ok
<
abs
-1800.0
*half-width
firstdrawable
1.0e-4
ok
<
abs
-56.0
*half-height
seconddrawable
1.0e-4

The upper edge is exactly NDC -1; the bar does not reserve a margin.

ok
<
abs
+1.0
-center-yhalf-height
1.0e-6
defteststatus-bar-panel-is-translucent-analytic-and-never-an-image
let
setf
clim:medium-inkmedium
mcluv::*status-bar-panel-ink*
let
vertices
mcluv::gpu-medium-analytic-verticesmedium
commands
mcluv::gpu-medium-commandsmedium
ok
<
abs
-0.72
arefvertices2
1.0e-5
ok
=1
lengthcommands
ok
typep
arefcommands0
'mcluv::gpu-analytic-command
let*
sheet
make-instance'mcluv::status-bar-pane:region
clim:make-bounding-rectangle0090028
mirror
make-instance'mcluv:luv-gpu-mirror:sheetsheet:targetnil:embedded-pt
multiple-value-bind
preparedtext-data
declare
ignoretext-data
ok
=1
lengthprepared
ok
null
find-if
lambda
command
prepared