formdefs.zil

"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>