Analog artist resize - version 1.2.3

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; changes since last post:
;; - some more tweaking of constants used for the outputs list heigth
;; - tests that IC version is > 4.4.2 , because field attachments are not supported in IC442.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; usage:
;; - load this and analog artist will look different.
;; - call ADErollback() and analog artist will be back to the same old.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



sstatus(debugMode t) sstatus(writeProtect t)

procedure( CsevSetWindowForm(session)
let(
;()
( CsevWindowFormInitialSize CsevWindowFormFields CsevWindowFormAttachments quotedfields)
session->windowForm = hiCreateAppForm(
?name sevGlobalSymbol('WindowForm session)
;;?initialSize t ;-] the simple truth is just not good enough.
?initialSize CsevWindowFormInitialSize=CsevSetWindowFormInitialSize() ;; CsevMainFormHeight should in fact retrieve window Ysize and substract banner+menu from that . Now gives roughly 372-49 = 323
?fields CsevWindowFormFields=CsevSetWindowFormFields(session)
?attachmentList let( ();(quotedfields)
quotedfields=mapcar(lambda( (Csevfield) getq(car(Csevfield) hiFieldSym ) ) CsevWindowFormFields)
CsevWindowFormAttachments=CsevSetWindowFormAttachments(quotedfields)
);let
);hiCreateAppForm
);let
);proc

procedure( CsevSetWindowFormInitialSize()
let(
;; from "xprop" : program specified size: 578 by 372
( (xpropXsize 577) (xpropYsize 367) (fieldattribXsize 536) (fieldattribYsize 359) )
;range(xpropXsize xpropYsize)
;range(fieldattribXsize fieldattribYsize)
;;536:312
;;536:318
;566:318
/* sevWindowWidth() => 578 ; sevWindowHeight() => 372 */
;;?initialSize list(sevMainFormWidth() CsevMainFormHeight())
;; CsevMainFormHeight should in fact retrieve window Ysize and substract banner+menu from that . Now gives roughly 372-49 = 323
list( sevWindowWidth()-3 sevWindowHeight()-90 )
));let&proc

/* ______________________________________________________________ */
;;load("CsevMainFormFieldSets.il")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the function that returns the fields. We _could_ tweak the following:
;; - frame size ? now default. pos=0:2 size=177:122
;; - boxheaders can be thinner
;; - boxlabels can be thinner

procedure( CsevMainFormFieldSets( session fieldName \@optional row)
let(
(
(formWidth sevMainFormWidth() ) ;536
(lboxWidth sevListBoxWidth(strlen(sevVarSummaryLine())) ) ;177
rboxWidth
(labelHeight 30)
(boxLabelHeight sevListBoxHeight(1) ) ;33
ySecondRow
(labelWidth 50)
(labelJustification 'left )
desFieldWidth
(topBoxRows 3)
(bottomBoxRows 6)
;;;;addons;;;;;
(desrefleftpos 10) ; position for the library , cell , view labels
) ; local vars declared
;;;;tweaks;;;;
labelHeight=labelHeight-9
tw3=5
;;
rboxWidth = formWidth - lboxWidth ;359
ySecondRow = labelHeight + boxLabelHeight - tw3 + sevListBoxHeight(topBoxRows) - tw3 ;122
desFieldWidth = lboxWidth - labelWidth

case( fieldName
(design
list(
/*
list(hiCreateFrameField(?name fieldName ?labelText " ")
2:2
;2:3
165:120 30
);Frame
*/
list(hiCreateLabel(?name
concat(fieldName
'Label
) ?labelText "Design" ?justification
'center
)
desrefleftpos 2+row * labelHeight)
( lboxWidth - desrefleftpos ):labelHeight

);Label
);fieldlist
);design

(lib
if( sevHiWithoutTurbo()
;;then
list(list(hiCreateOutputStringField(?name fieldName ?prompt "Library" ?value (sevLibrary(session) || ""))
desrefleftpos row*labelHeight+6)
( lboxWidth - 8 - desrefleftpos):labelHeight labelWidth ))
;;else
list(list(hiCreateLabel(?name concat(fieldName 'Label) ?labelText "Library" ?justification labelJustification )
desrefleftpos row*labelHeight+6)
labelWidth:labelHeight )
list(hiCreateStringField(?name fieldName ?value (sevLibrary(session) || "") ?editable nil )
labelWidth row*labelHeight+6)
desFieldWidth:labelHeight ))
);fi
);lib
(cell
if( sevHiWithoutTurbo() list(list(hiCreateOutputStringField(?name fieldName ?prompt "Cell" ?value
(sevCell(session) || "")
)
(desrefleftpos( row * labelHeight) + 2))
( lboxWidth - 8 - desrefleftpos):labelHeight labelWidth
)
) list(list(hiCreateLabel(?name
concat(fieldName
'Label
) ?labelText "Cell" ?justification
labelJustification
)
(desrefleftpos( row * labelHeight) + 2))
( labelWidth - desrefleftpos):labelHeight
)
list(hiCreateStringField(?name fieldName ?value
(sevCell(session) || "") ?editable
nil
)
(labelWidth - desrefleftpos)( row * labelHeight) + 2)
(desFieldWidth:labelHeight)
)
)))
(view
if( sevHiWithoutTurbo() list(list(hiCreateOutputStringField(?name fieldName ?prompt "View" ?value
(sevView(session) || "")
)
(desrefleftpos( row * labelHeight) - 2) )
( lboxWidth - 8 - desrefleftpos):labelHeight labelWidth
)
) list(list(hiCreateLabel(?name
concat(fieldName
'Label
) ?labelText "View" ?justification
labelJustification
)
desrefleftpos row*labelHeight - 2)
( labelWidth - desrefleftpos):labelHeight
)
list(hiCreateStringField(?name fieldName ?value
(sevView(session) || "") ?editable
nil
)
labelWidth row*labelHeight - 2)
( desFieldWidth - desrefleftpos):labelHeight
)
)))
(anaListBox
list(list(hiCreateLabel(?name
concat(fieldName
'Header
) ?labelText "Analyses" ?justification
'center
)
lboxWidth row * labelHeight)
rboxWidth:labelHeight
)
list(hiCreateListBoxField(?name
concat(fieldName
'Label
) ?choices
list(sevAnaSummaryLine()) ?numRows
1 ?changeCB
sprintf(nil "(sevUnselectAll '%L)" session)
)
lboxWidthadd1(row) * labelHeight)
rboxWidth:boxLabelHeight
)
list(hiCreateListBoxField(?name fieldName ?choices
sevNonEmptyStringList() ?numRows
topBoxRows ?changeCB
buildString(list(sprintf(nil "(sevUnselectVars '%L)" session)
sprintf(nil "(sevUnselectOuts '%L)" session)
)
) ?doubleClickCB
sprintf(nil "(sevEditSelectedAnas '%L)" session)
?multipleSelect t
)
lboxWidth add1(row)*labelHeight + boxLabelHeight - tw3 - 8 )
rboxWidthsevListBoxHeight(topBoxRows) + 8 )
)
))
(varListBox
list(list(hiCreateLabel(?name
concat(fieldName
'Header
) ?labelText "Design Variables" ?justification
'center
)
0:ySecondRow
lboxWidth:labelHeight
)
list(hiCreateListBoxField(?name
concat(fieldName
'Label
) ?choices
list(sevVarSummaryLine()) ?numRows
1 ?changeCB
sprintf(nil "(sevUnselectAll '%L)" session)
)
0 ySecondRow + labelHeight)
lboxWidth:boxLabelHeight
)
list(hiCreateListBoxField(?name fieldName ?choices
sevNonEmptyStringList() ?numRows
bottomBoxRows ?changeCB
buildString(list(sprintf(nil "(sevUnselectAnas '%L)" session)
sprintf(nil "(sevUnselectOuts '%L)" session)
)
) ?doubleClickCB
sprintf(nil "(sevEditSelectedVars '%L)" session)
?multipleSelect t
)
0 ySecondRow + labelHeight + boxLabelHeight - tw3 - 8)
lboxWidthsevListBoxHeight(bottomBoxRows) + -3 )
)
))
(outListBox
list(list(hiCreateLabel(?name
concat(fieldName
'Header
) ?labelText "Outputs" ?justification
'center
)
lboxWidth:ySecondRow
rboxWidth:labelHeight
);outListBox label
list(hiCreateListBoxField(?name
concat(fieldName
'Label
) ?choices
list(sevOutSummaryLine()) ?numRows
1 ?changeCB
sprintf(nil "(sevUnselectAll '%L)" session)
)
lboxWidth ySecondRow + labelHeight )
rboxWidth:boxLabelHeight
);outListBox header
list(hiCreateListBoxField(?name fieldName ?choices
sevNonEmptyStringList() ?numRows
bottomBoxRows ?changeCB
buildString(list(sprintf(nil "(sevUnselectAnas '%L)" session)
sprintf(nil "(sevUnselectVars '%L)" session)
)
) ?doubleClickCB
sprintf(nil "(sevEditSelectedOuts '%L)" session)
?multipleSelect t
)
lboxWidth ySecondRow + labelHeight + boxLabelHeight - tw3 - 8 )
rboxWidthsevListBoxHeight(bottomBoxRows) + -3)
);outListBox outputs list
));outListBox
(prompt
list(list(hiCreateLabel(?name fieldName ?labelText " " ?justification
'left
)
0 ySecondRow + labelHeight + boxLabelHeight - tw3 + sevListBoxHeight(bottomBoxRows) + -17)
(formWidth:26)
)
));prompt
); case fieldname
);let
);procedure

/* ______________________________________________________________ */

procedure( CsevSetWindowFormFields(session)
let( ( (row 0) )
mapcan(
lambda( (fieldWithArgs)
apply('CsevMainFormFieldSets cons(session fieldWithArgs) )
);lambda
list(
list('design row )
list('lib ++row )
list('cell ++row )
list('view ++row )
list('varListBox)
list('anaListBox (row = 0) )
list('outListBox)
list('prompt)
)
);mapcan
))
/* __________________________________________________ */
procedure( CsevSetWindowFormAttachments(fields)
let( ()
/*fields=list(
'design 'designLabel 'lib 'cell 'view 'varListBoxHeader
'varListBoxLabel 'varListBox 'anaListBoxHeader 'anaListBoxLabel 'anaListBox
'outListBoxHeader 'outListBoxLabel
;; 'artistPlottingMode 'myfield ;;this must be uncommented with ic51
'outListBox 'prompt
)
*/
foreach( mapcar field fields
CsevMainFormAttachments( field )
)
))
/* __________________________________________________ */
/*
unless(boundp('hicTopPositionSet)
hicLeftPositionSet= 2
hicLeftPercentSet= 1
hicRightPositionSet= 32
hicRightPercentSet= 16
hicTopPositionSet= 8
hicTopPercentSet= 4
hicBottomPositionSet= 128
hicBottomPercentSet= 64
)
*/

procedure( CsevMainFormAttachments( field )
let(( LLF LRF LD RRF RLF RD TTF TBF TD BBF BTF BD (unspecified 0))
;; LLF is Left side of field following Left side of form at Fixed distance
LLF=hicLeftPositionSet
;; LRF is Left side of field following Right side of form at Fixed distance
LRF=unspecified ;; alas, this doesnt exist. But it will work if RRF and left is unspecified ( nil ).
;; LD is Left side of field following Dynamic right and left side of form at proportional position.
LD=hicLeftPercentSet
;; et coetera
RRF=hicRightPositionSet
RLF=unspecified ;this is default behaviour when no attachment exists
RD=hicRightPercentSet
TTF=hicTopPositionSet
TBF=unspecified ;; it works with BBF
TD=hicTopPercentSet
BBF=hicBottomPositionSet
BTF=unspecified
BD=hicBottomPercentSet
;;
;;design designLabel lib cell view varListBoxHeader
;;varListBoxLabel varListBox anaListBoxHeader anaListBoxLabel anaListBox
;;outListBoxHeader outListBoxLabel artistPlottingMode myfield outListBox
;;prompt
errset(if( debug printf("attaching field %L\n" field) ))
case(field
((design designLabel lib cell view) TTF|BTF|LLF|RD )
((anaListBox anaListBoxHeader anaListBoxLabel) TTF|BTF|LD|RRF )
((varListBoxHeader varListBoxLabel) TTF|BTF|LLF|RD )
(varListBox TTF|BBF|LLF|RD )
((outListBoxHeader outListBoxLabel) TTF|BTF|LD|RRF )
(outListBox TTF|BBF|LD|RRF )
((artistPlottingMode myfield) TBF|BBF|LD|RRF )
(prompt TBF|BBF|LLF|RRF )
; (t unspecified)
(t nil)
);case
);let
);procedure

/* __________________________________________________ */
when( !boundp('CsevSetWindowForm_org)
CsevSetWindowForm_org=getd('sevSetWindowForm)
procedure( ADErollback() putd('sevSetWindowForm CsevSetWindowForm_org) ));when
if( boundp('CsevSetWindowForm_org)
then putd('sevSetWindowForm getd('CsevSetWindowForm))
else warn("analog artist resize fix: could not backup original AA functions. Aborting.")
);fi