;;; Inertly recovered online-help source contexts.
;;; Original System 46 file: lmio1/hacks.189
;;; Exact source bytes follow each generated provenance comment.

;;; Source bytes 5971:9015; lines 207-298; sha256 a9db61d8dd6deaa132aeff8cabed01c7fb8e21981c0200137a91ef64bbeb0a99
(DEFUN MUNCH (&OPTIONAL M &AUX CHC TEM FLAG TVB)
  (AND M (SETQ MUNCH M))
  (BIND-FONT-MAP ('(FONTS:CPTFONT FONTS:43VXMS))
   (OR (BOUNDP 'MUNCH)
       (SETQ MUNCH 1))
   (SETQ TVB (TV:SHEET-SCREEN-ARRAY TERMINAL-IO))
   (FUNCALL TERMINAL-IO ':CLEAR-SCREEN)
   (OR (BOUNDP 'MUNCH-SWITCHES)
       (SETQ MUNCH-SWITCHES
	     (CREATE-SWITCH-REGISTER TERMINAL-IO 20 NIL (* 3 (// 1100 4)))))
   (FUNCALL MUNCH-SWITCHES NIL)
   (FUNCALL MUNCH-SWITCHES MUNCH)
   (BIND-FONT (FONTS:43VXMS)
	(FUNCALL TERMINAL-IO ':SET-CURSORPOS 0 0)
	(FUNCALL TERMINAL-IO ':CLEAR-EOL)
	(PRINC MUNCH))
   (DO
    ((AB 0) (X) (Y) (CH) (NEW-KBD-P)
     (XOFF (+ (TV:SHEET-INSIDE-LEFT TERMINAL-IO)
	      (// (TV:SHEET-INSIDE-WIDTH TERMINAL-IO) 2)
	      -128.))
     (YOFF (+ 143 (TV:SHEET-INSIDE-TOP TERMINAL-IO))))
    (NIL)
    L (MULTIPLE-VALUE (CH NEW-KBD-P)	;this doesnt really get returnned yet
	(KBD-TYI-NO-HANG))
    (COND ((NULL CH) (GO DIS)))
    (SETQ CHC (CHAR-UPCASE (LOGAND 377 CH)))
    (COND ((= CHC #\BREAK)
	   (RETURN NIL))
	  ((= CHC #\ESCAPE)
	   (SETQ FLAG T)
	   (SETQ MUNCH (NHNWSNOOB MUNCH)))
	  ((MEMQ CHC '(#/0 #/1 #/2 #/3 #/4 #/5 #/6 #/7 #/8 #/9))
	   (SETQ FLAG T)
	   (SETQ MUNCH (+ (LSH MUNCH 3) (- CHC #/0))))
	  ((= CHC #\CLEAR)
	   (SETQ FLAG T)
	   (SETQ MUNCH 0))
	  ((= CHC #/+)
	   (SETQ FLAG T)
	   (SETQ MUNCH (1+ MUNCH)))
	  ((= CHC #/)
	   (SETQ FLAG T)
	   (SETQ MUNCH (1+ (LSH MUNCH 1))))
	  ((= CHC #/<)
	   (SETQ FLAG T)
	   (SETQ MUNCH (LSH MUNCH 1)))
	  ((= CHC #/>)
	   (SETQ FLAG T)
	   (SETQ MUNCH (LSH MUNCH -1)))
	  ((= CHC #\FORM)
	   (SETQ FLAG T))
	  ((= CHC #/?)
	   (SETQ FLAG T)
	   (FUNCALL TERMINAL-IO 'SET-CURSORPOS 0 0)
	   (PRINC "SPACE increments, ESC does NHNWSNOOB, < is a left shift,")
	   (PRINC "M shift left, but shift in a 1 bit,")
	   (PRINC "> is a right shift, FORM clears the AC, CLEAR is like form but")
	   (PRINC "zeroes the switches, the center row of keys toggles the switches,")
	   (PRINC "CIRCLE-PLUS single steps,")
	   (PRINC "BREAK exits.")
	   (KBD-TYI)
	   (FUNCALL MUNCH-SWITCHES NIL))
	  ((SETQ TEM (FIND-POSITION-IN-LIST
		       CHC 
		       (COND (NEW-KBD-P '(#/\ #\LF #\CR #/' #/; #/L #/K #/J #/H #/G
					  #/F #/D #/S #/A #/W #/Q))
			     (T '(#\BACK-NEXT #\LF #\CR #/: #/; #/L #/K #/J #/H #/G
				  #/F #/D #/S #/A #\RUBOUT #\VT)))))
	   (SETQ FLAG T)
	   (SETQ MUNCH (LOGXOR MUNCH (LSH 1 TEM)))))
    (COND (FLAG
	   (SETQ FLAG NIL)
	   (SETQ AB 0)
	   (SETQ MUNCH (LOGAND 177777 MUNCH))
	   (FUNCALL TERMINAL-IO ':DRAW-RECTANGLE 256. 256. XOFF YOFF
		    (TV:SHEET-ERASE-ALUF TERMINAL-IO))
	   (FUNCALL MUNCH-SWITCHES MUNCH)
	   (BIND-FONT (FONTS:43VXMS)
		      (FUNCALL TERMINAL-IO ':SET-CURSORPOS 0 0)
		      (FUNCALL TERMINAL-IO ':CLEAR-EOL)
		      (PRINC MUNCH))))
    (GO L)
 DIS
    (TV:PREPARE-SHEET (TERMINAL-IO)
       (DO () ((SI:KBD-HARDWARE-CHAR-AVAILABLE))
	 (SETQ AB (LOGAND 177777 (+ AB MUNCH)))
	 (SETQ X (LOGAND AB 377))
	 (SETQ Y (+ YOFF (LOGXOR X (LDB 1010 AB))))
	 (SETQ X (+ X XOFF))
	 (AS-2 (LOGXOR 1 (AR-2 TVB X Y)) TVB X Y)))
    (GO L))))