mirror of
https://github.com/historicalsource/bureaucracy
synced 2024-04-25 21:59:44 +03:00
132 lines
4.1 KiB
Plaintext
132 lines
4.1 KiB
Plaintext
"FORMDEFS for BUREAUCRACY: Copyright (C)1987 Infocom, Inc. All rights reserved."
|
|
|
|
<ZSECTION "FORMDEFS">
|
|
|
|
<FILE-FLAGS MDL-ZIL?>
|
|
|
|
<USE "NEWSTRUC">
|
|
|
|
<SET-DEFSTRUCT-FILE-DEFAULTS ('NTH ZGET) ('PUT ZPUT) ('START-OFFSET 0)
|
|
'NODECL>
|
|
|
|
<SETG FORM-X 0>
|
|
<SETG FORM-Y 0>
|
|
|
|
"Args for field functions"
|
|
<MSETG FORM-EXIT-FIELD 1>
|
|
<MSETG FORM-ADD-CHAR 2>
|
|
<MSETG FORM-DO-ECHO? 3>
|
|
<MSETG FORM-UPPERCASE? 4>
|
|
<MSETG FORM-OK-TO-ENTER-FIELD? 5>
|
|
<MSETG FORM-FIELD-RESET 6>
|
|
|
|
<MSETG FORM-WIDTH 40>
|
|
<MSETG FORM-LENGTH 18>
|
|
<MSETG ERROR-LINE 3>
|
|
<MSETG FIRST-FORM-LINE 5>
|
|
|
|
; "Structure to represent a single field."
|
|
; "Form is just a table of fields. Internally, we enforce the restriction
|
|
that there can be no more than two fields on a line."
|
|
|
|
<DEFSTRUCT FIELD (TABLE ('NTH GETB) ('PUT PUTB))
|
|
(FIELD-PROMPT ANY 'NTH ZGET 'PUT ZPUT 'NONE)
|
|
; "Compressed string, we hope..."
|
|
(FIELD-FCN ANY 'NTH ZGET 'PUT ZPUT 'NONE)
|
|
; "Routine to call at various times"
|
|
(FIELD-ABUSE ANY 'NTH ZGET 'PUT ZPUT <>)
|
|
(FIELD-DUMMY-1 ANY 'NONE)
|
|
(FIELD-DUMMY-2 ANY 'NONE)
|
|
(FIELD-DUMMY-3 ANY 'NONE)
|
|
(FIELD-PROMPTLEN FIX) ; "Length of frob"
|
|
(FIELD-X FIX)
|
|
(FIELD-Y FIX)
|
|
(FIELD-MAXLEN FIX)
|
|
(FIELD-DONE FIX 0)
|
|
; "This field can't be moved, because it makes the data in the
|
|
field look like a byte table with a length..."
|
|
(FIELD-CURLEN FIX)
|
|
(FIELD-DATA ANY 'NONE)>
|
|
|
|
<MSETG FIELD-DATA-OFFSET 12>
|
|
|
|
; "Field syntax is
|
|
(name:ATOM prompt:STRING maxlen:FIX OPT init:STRING)"
|
|
|
|
<DEFMAC BUILD-FORM (NAME "ARGS" FIELDS)
|
|
<SETG20 CURRENT-FORM-NAME .NAME>
|
|
<REALLY-BUILD-FORM !.FIELDS>>
|
|
|
|
<DEFINE20 GET-FIELD-WIDTH (FIELD:LIST)
|
|
<+ <LENGTH <2 .FIELD>:STRING> <3 .FIELD>:FIX 1>>
|
|
|
|
<DEFINE20 REALLY-BUILD-FORM ("TUPLE" FIELDS "AUX" (FIELDN 1)
|
|
(LINE ,FIRST-FORM-LINE))
|
|
<SETG20 FIELDS (T)>
|
|
<SETG20 FIELDL ,FIELDS>
|
|
<REPEAT (FIELD)
|
|
<COND (<EMPTY? .FIELDS> <RETURN>)>
|
|
<SET FIELD <1 .FIELDS>>
|
|
<COND (<AND <NOT <EMPTY? <REST .FIELDS>>>
|
|
<L? <+ <GET-FIELD-WIDTH .FIELD>
|
|
<GET-FIELD-WIDTH <2 .FIELDS>>
|
|
1>
|
|
<- ,FORM-WIDTH 2>>>
|
|
<BUILD-LINE .LINE .FIELD .FIELDN <2 .FIELDS> <+ .FIELDN 1>>
|
|
<SET FIELDN <+ .FIELDN 2>>
|
|
<SET FIELDS <REST .FIELDS>>)
|
|
(T
|
|
<BUILD-LINE .LINE .FIELD .FIELDN>
|
|
<SET FIELDN <+ .FIELDN 1>>)>
|
|
<SET LINE <+ .LINE 1>>
|
|
<SET FIELDS <REST .FIELDS>>>
|
|
<FINISH-FORM-BUILD>>
|
|
|
|
<DEFINE20 FINISH-FORM-BUILD ()
|
|
<EVAL <FORM GLOBAL ,CURRENT-FORM-NAME <TABLE (PURE LENGTH)
|
|
!<REST ,FIELDS>>>>
|
|
<COND (<G? <FIELD-Y <NTH ,FIELDS <LENGTH ,FIELDS>>> <- ,FORM-LENGTH 1>>
|
|
<ERROR FORM-TOO-BIG <FIELD-Y <NTH ,FIELDS <LENGTH ,FIELDS>>>
|
|
,FORM-LENGTH>)>>
|
|
|
|
<DEFINE20 BUILD-LINE (LINENO:FIX F1:LIST F1N:FIX "OPT" F2:LIST F2N:FIX)
|
|
<BUILD-FIELD .F1 .F1N 1 .LINENO>
|
|
<COND (<ASSIGNED? F2>
|
|
<BUILD-FIELD .F2 .F2N <- ,FORM-WIDTH <GET-FIELD-WIDTH .F2> 2>
|
|
.LINENO>)>>
|
|
|
|
<DEFINE20 BUILD-FIELD (FIELD:LIST FIELDNO:FIX X:FIX Y:FIX "AUX" FTBL)
|
|
<COND (<G? <+ <LENGTH <2 .FIELD>> 1 <3 .FIELD>>
|
|
<- ,FORM-WIDTH 2>>
|
|
<ERROR FIELD-TOO-WIDE-FOR-FORM!-ERRORS .FIELD .FIELDNO .X .Y>)>
|
|
<MAKE-FIELD 'FIELD <SET FTBL <CHTYPE <ITABLE <+ ,FIELD-DATA-OFFSET
|
|
<3 .FIELD>:FIX>
|
|
(BYTE)>
|
|
FIELD>>
|
|
'FIELD-PROMPT <2 .FIELD>
|
|
'FIELD-PROMPTLEN <+ <LENGTH <2 .FIELD>> 1>
|
|
'FIELD-X .X
|
|
'FIELD-Y .Y
|
|
'FIELD-MAXLEN <3 .FIELD>
|
|
'FIELD-CURLEN 0
|
|
'FIELD-ABUSE <COND (<TYPE? <NTH .FIELD <LENGTH .FIELD>> TABLE>
|
|
<NTH .FIELD <LENGTH .FIELD>>)
|
|
(<TYPE? <NTH .FIELD <LENGTH .FIELD>> FORM>
|
|
<EVAL <NTH .FIELD <LENGTH .FIELD>>>)>>
|
|
<COND (<TYPE? <NTH .FIELD <LENGTH .FIELD>> ATOM>
|
|
<FIELD-FCN .FTBL <NTH .FIELD <LENGTH .FIELD>>>)
|
|
(<TYPE? <NTH .FIELD <- <LENGTH .FIELD> 1>> ATOM>
|
|
<FIELD-FCN .FTBL <NTH .FIELD <- <LENGTH .FIELD> 1>>>)>
|
|
<EVAL <FORM CONSTANT <1 .FIELD> <- .FIELDNO 1>>>
|
|
<SETG20 FIELDL <REST <PUTREST ,FIELDL (.FTBL)>>>
|
|
<COND (<AND <G? <LENGTH .FIELD> 3>
|
|
<TYPE? <4 .FIELD> STRING>>
|
|
<FIELD-CURLEN .FTBL <LENGTH <4 .FIELD>:STRING>>
|
|
<REPEAT ((OFFS ,FIELD-DATA-OFFSET) (STR:STRING <4 .FIELD>))
|
|
<PUTB .FTBL .OFFS <BYTE <ASCII <1 .STR>>>>
|
|
<COND (<EMPTY? <SET STR <REST .STR>>>
|
|
<RETURN>)>
|
|
<SET OFFS <+ .OFFS 1>>>)>>
|
|
|
|
<ENDSECTION>
|