/*
 * Copyright (c) 2000 Apple Computer, Inc. All rights reserved.
 *
 * @APPLE_LICENSE_HEADER_START@
 * 
 * Copyright (c) 1999-2003 Apple Computer, Inc.  All Rights Reserved.
 * 
 * This file contains Original Code and/or Modifications of Original Code
 * as defined in and that are subject to the Apple Public Source License
 * Version 2.0 (the 'License'). You may not use this file except in
 * compliance with the License. Please obtain a copy of the License at
 * http://www.opensource.apple.com/apsl/ and read it before using this
 * file.
 * 
 * The Original Code and all software distributed under the License are
 * distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER
 * EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
 * INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT.
 * Please see the License for the specific language governing rights and
 * limitations under the License.
 * 
 * @APPLE_LICENSE_HEADER_END@
 */
/*
 *  Control2.c - OF replacement driver for Control.
 *
 *  Copyright (c) 1998-2000 Apple Computer, Inc.
 *
 *  DRI: Josh de Cesare
 */

const char *gControl2Source[] = {
	"\" /chaos/control\" find-device "
	"-1 value bankB? "
	"-1 value REGS "
	"-1 value FB-ADDRESS "
	"-1 value phys-regs "
	"-1 value phys-fb-address "
	"0 value mono-mode? "
	"0 value width "
	"0 value height "
	"0 value sense-code "
	"0 value ext-sense "
	"h# F301B000 constant RADACAL "
	"h# F301B000 constant RADACAL-base "
	"variable RGB-temp "
	"struct "
	"( 000 )	d# 16	field	>C.CUR-LINE "
	"( 010 )	d# 16	field	>C.VFPEQ "
	"( 020 )	d# 16	field	>C.VFP "
	"( 030 )	d# 16	field	>C.VAL "
	"( 040 )	d# 16	field	>C.VBP "
	"( 050 )	d# 16	field	>C.VBPEQ "
	"( 060 )	d# 16	field	>C.VSYNC "
	"( 070 )	d# 16	field	>C.VHLINE "
	"( 080 )	d# 16	field	>C.PIPED "
	"( 090 )	d# 16	field	>C.HPIX "
	"( 0A0 )	d# 16	field	>C.HFP "
	"( 0B0 )	d# 16	field	>C.HAL "
	"( 0C0 )	d# 16	field	>C.HBWAY "
	"( 0D0 )	d# 16	field	>C.HSP "
	"( 0E0 )	d# 16	field	>C.HEQ "
	"( 0F0 )	d# 16	field	>C.HLFLN "
	"( 100 )	d# 16	field	>C.HSERR "
	"( 110 )	d# 16	field	>C.CNTTST "
	"( 120 )	d# 16	field	>C.TEST "
	"( 130 )	d# 16	field	>C.GBASE "
	"( 140 )	d# 16	field	>C.ROW-WORDS "
	"( 150 )	d# 16	field	>C.MON-SENSE "
	"( 160 )	d# 16	field	>C.ENABLE "
	"( 170 )	d# 16	field	>C.GSC-DIVIDE "
	"( 180 )	d# 16	field	>C.REFRESH-COUNT "
	"( 190 )	d# 16	field	>C.INT-ENABLE "
	"( 1A0 )	d# 16	field	>C.INT-STATUS "
	"drop "
	"struct "
	"d# 16	field	>R.REG-ADDR "
	"d# 16	field	>R.CRSR-PALETTE "
	"d# 16	field	>R.REG-DATA "
	"d# 16	field	>R.COLOR-PALETTE "
	"drop "
	"create k512x384@60 "
	"h# 0E1B6210 L, "
	"d# 811 w, d# 810 w, d# 42 w, d# 23 w, d# 4 w, d# 812 w, d# 814 w, d# 48 w, "
	"d# 318 w, d# 305 w, d# 49 w, d# 15 w, d# 319 w, d# 8 w, d# 160 w, d# 304 w, "
	"d# 2 w, d# 512 w, d# 384 w, "
	"create k640x480@67 "
	"h# 0E1B0210 L, "
	"d# 1045 w, d# 1042 w, d# 82 w, d# 43 w, d# 4 w, d# 1048 w, d# 1050 w, d# 72 w, "
	"d# 430 w, d# 393 w, d# 73 w, d# 31 w, d# 431 w, d# 16 w, d# 216 w, d# 400 w, "
	"d# 2 w, d# 640 w, d# 480 w, "
	"create k640x870@75 "
	"h# 172A0310 L, "
	"d# 1831 w, d# 1828 w, d# 88 w, d# 46 w, d# 4 w, d# 1834 w, d# 1836 w, d# 72 w, "
	"d# 414 w, d# 393 w, d# 73 w, d# 39 w, d# 415 w, d# 20 w, d# 208 w, d# 376 w, "
	"d# 2 w, d# 640 w, d# 870 w, "
	"create k640x480@60VGA "
	"h# 17250210 L, "
	"d# 1037 w, d# 1026 w, d# 66 w, d# 34 w, d# 2 w, d# 1048 w, d# 1050 w, d# 64 w, "
	"d# 398 w, d# 385 w, d# 65 w, d# 47 w, d# 399 w, d# 24 w, d# 200 w, d# 352 w, "
	"d# 2 w, d# 640 w, d# 480 w, "
	"create k832x624@75 "
	"h# 172A0310 L, "
	"d# 1331 w, d# 1330 w, d# 82 w, d# 43 w, d# 4 w, d# 1332 w, d# 1334 w, d# 136 w, "
	"d# 574 w, d# 553 w, d# 137 w, d# 31 w, d# 575 w, d# 16 w, d# 288 w, d# 544 w, "
	"d# 2 w, d# 832 w, d# 624 w, "
	"create k1024x768@75 "
	"h# 0B1C0310 L, "
	"d# 1603 w, d# 1600 w, d# 64 w, d# 34 w, d# 4 w, d# 1606 w, d# 1608 w, d# 128 w, "
	"d# 662 w, d# 641 w, d# 129 w, d# 47 w, d# 663 w, d# 24 w, d# 332 w, d# 616 w, "
	"d# 2 w, d# 1024 w, d# 768 w, "
	"create k1152x870@75 "
	"h# 133D0310 L, "
	"d# 1825 w, d# 1822 w, d# 82 w, d# 43 w, d# 4 w, d# 1828 w, d# 1830 w, d# 128 w, "
	"d# 726 w, d# 705 w, d# 129 w, d# 63 w, d# 727 w, d# 32 w, d# 364 w, d# 664 w, "
	"d# 2 w, d# 1152 w, d# 870 w, "
	": SENSE! 5 ms regs >C.MON-SENSE rl! 5 ms ; "
	": SENSE@ 5 ms regs >C.MON-SENSE rl@ 5 ms ; "
	": MON-SENSE	( -- ) "
	"o# 70 sense! "
	"sense@ 6 >> 7 and dup to sense-code "
	"dup 6 < if "
	"b# 1000000 or "
	"else drop "
	"o# 30 sense! "
	"sense@ 2 >> b# 110000 and "
	"o# 50 sense! "
	"sense@ dup 4 >> b# 000100 and swap 5 >> b# 001000 and or or "
	"o# 60 sense! sense@ 7 >> b# 000011 and or "
	"to ext-sense "
	"then "
	"o# 70 sense! "
	"; "
	": get-mode ( -- mode-table mono-mode? ) "
	"sense-code case "
	"0 of "
	"false "
	"k1152x870@75 "
	"endof "
	"1 of "
	"true "
	"k640x870@75 "
	"endof "
	"2 of "
	"false "
	"k512x384@60 "
	"endof "
	"3 of "
	"true "
	"k1152x870@75 "
	"endof "
	"5 of "
	"false "
	"k640x870@75 "
	"endof "
	"6 of "
	"ext-sense case "
	"3 of "
	"false "
	"k832x624@75 "
	"endof "
	"h# 0b of "
	"false "
	"k1024x768@75 "
	"endof "
	"h# 23 of "
	"false "
	"k1152x870@75 "
	"endof "
	"drop "
	"false "
	"k640x480@67 "
	"0 endcase "
	"endof "
	"7 of "
	"ext-sense case "
	"h# 2d of "
	"false "
	"k832x624@75 "
	"endof "
	"h# 3a of "
	"false "
	"k1024x768@75 "
	"endof "
	"h# 17 of "
	"false "
	"k640x480@60VGA "
	"endof "
	"h# 3f of "
	"false "
	"0 "
	"endof "
	"drop "
	"false "
	"k640x480@67 "
	"0 endcase "
	"endof "
	"drop "
	"false "
	"k640x480@67 "
	"0 endcase "
	"; "
	"HEADERLESS "
	"create std-16 "
	"\" \"(000000 0000AA 00AA00 00AAAA AA0000 AA00AA AA5500 AAAAAA)\" $c, "
	"\" \"(555555 5555FF 55FF55 55FFFF FF5555 FF55FF FFFF55 FFFFFF)\" $c, "
	"create std-gamma "
	"\" \"(00 05 09 0B 0E 10 13 15 17 19 1B 1D 1E 20 22 24)\" $c, "
	"\" \"(25 27 28 2A 2C 2D 2F 30 31 33 34 36 37 38 3A 3B)\" $c, "
	"\" \"(3C 3E 3F 40 42 43 44 45 47 48 49 4A 4B 4D 4E 4F)\" $c, "
	"\" \"(50 51 52 54 55 56 57 58 59 5A 5B 5C 5E 5F 60 61)\" $c, "
	"\" \"(62 63 64 65 66 67 68 69 6A 6B 6C 6D 6E 6F 70 71)\" $c, "
	"\" \"(72 73 74 75 76 77 78 79 7A 7B 7C 7D 7E 7F 80 81)\" $c, "
	"\" \"(81 82 83 84 85 86 87 88 89 8A 8B 8C 8C 8D 8E 8F)\" $c, "
	"\" \"(90 91 92 93 94 95 95 96 97 98 99 9A 9B 9B 9C 9D)\" $c, "
	"\" \"(9E 9F A0 A1 A1 A2 A3 A4 A5 A6 A6 A7 A8 A9 AA AB)\" $c, "
	"\" \"(AB AC AD AE AF B0 B0 B1 B2 B3 B4 B4 B5 B6 B7 B8)\" $c, "
	"\" \"(B8 B9 BA BB BC BC BD BE BF C0 C0 C1 C2 C3 C3 C4)\" $c, "
	"\" \"(C5 C6 C7 C7 C8 C9 CA CA CB CC CD CD CE CF D0 D0)\" $c, "
	"\" \"(D1 D2 D3 D3 D4 D5 D6 D6 D7 D8 D9 D9 DA DB DC DC)\" $c, "
	"\" \"(DD DE DF DF E0 E1 E1 E2 E3 E4 E4 E5 E6 E7 E7 E8)\" $c, "
	"\" \"(E9 E9 EA EB EC EC ED EE EE EF F0 F1 F1 F2 F3 F3)\" $c, "
	"\" \"(F4 F5 F5 F6 F7 F8 F8 F9 FA FA FB FC FC FD FE FF)\" $c, "
	": c+		( adr -- adr+1 val ) "
	"dup 1+ swap c@ "
	"; "
	": c!+		( adr val -- adr+1 ) "
	"swap dup 1+ -rot c! "
	"; "
	": do-gamma "
	"std-gamma + c@ "
	"; "
	": anti-gamma	( val -- orig ) "
	"h# 100 0 do "
	"std-gamma i + c@ over >= if "
	"drop i unloop exit "
	"then "
	"loop "
	"drop h# ff "
	"; "
	": W@++	( addr -- addr word ) "
	"dup 2+ swap w@ "
	"; "
	": CLUT@ ( -- ) "
	"3 0 do RADACAL-base >R.COLOR-PALETTE rb@ loop 2 ms "
	"; "
	": CLUT!	( -- ) "
	"3 0 do RADACAL-base >R.COLOR-PALETTE rb! loop 2 ms "
	"; "
	": RAD-REG-ADDR! "
	"RADACAL-base >R.REG-ADDR rb! 2 ms "
	"; "
	": RAD!	( c a -- ) "
	"( a ) rad-reg-addr! "
	"( c ) 	RADACAL-base >R.REG-DATA rb! 2 ms "
	"; "
	": init-RADACAL ( val -- ) "
	"( val ) h# 20 rad! "
	"bankb? 1 and h# 21 rad! "
	"0	h# 10 rad! "
	"0	h# 11 rad! "
	"; "
	"h# F3016000 constant vPortB "
	"h# F3016400 constant vDDRB "
	"h# F3017400 constant vSHR "
	"h# F3017600 constant vACR "
	"h# F3017800 constant vPCR "
	"h# F3017A00 constant vIFR "
	"h# F3017C00 constant vIER "
	"h# 0C constant kSRModeIn "
	"h# 1C constant kSRModeOut "
	"h# 04 constant kSRIReq "
	"h# 10 constant kByteAckBit "
	"h# DF constant kAssertTIP "
	"h# 20 constant kNegateTIP "
	"h# EF constant kAssertByteAck "
	"h# 10 constant kNegateByteAck "
	"h# 30 constant kTIPByteAckNeg "
	"h# 08 constant kTREQBit "
	": setByteAck "
	"vPortB rb@ swap if "
	"kAssertByteAck and "
	"else "
	"kNegateByteAck or "
	"then "
	"vPortB rb! "
	"; "
	": ToggleByteAck "
	"vPortB rb@ kByteAckBit and setByteAck "
	"; "
	": setTIP "
	"vPortB rb@ swap if "
	"kAssertTIP and "
	"else "
	"kTIPByteAckNeg or "
	"then "
	"vPortB rb! "
	"; "
	": ?TREQ	vPortB rb@ kTREQbit and 0= ; "
	": WaitTREQ "
	"begin "
	"?TREQ until "
	"; "
	": WaitVIAInt "
	"begin "
	"vIFR rb@ kSRIReq and until "
	"; "
	": WaitATTN "
	"WaitVIAInt "
	"vSHR rb@ drop "
	"; "
	": get-response	( -- ) "
	"WaitATTN "
	"true setTIP "
	"begin "
	"WaitATTN "
	"?TREQ while "
	"ToggleByteAck "
	"repeat "
	"false setTIP "
	"false setByteAck "
	"WaitATTN "
	"; "
	": start-send	( c -- ) "
	"kSRModeOut vACR rb! "
	"( c ) vSHR rb! "
	"true setTIP "
	"; "
	": cuda-write	{ _adr _len ; _actual _data } "
	"?TREQ if get-response then "
	"_adr c@ start-send "
	"begin "
	"WaitVIAInt "
	"?TREQ while "
	"vSHR rb@ drop "
	"false setTIP "
	"get-response "
	"_adr c@ start-send "
	"repeat "
	"1 -> _actual "
	"_len 1 ?do "
	"_adr i + c@ vSHR rb! "
	"_actual 1+ -> _actual "
	"ToggleByteAck "
	"WaitVIAInt "
	"loop "
	"2 ms "
	"kSRModeIn vACR rb! "
	"vSHR rb@ drop "
	"false setTIP "
	"false setByteAck "
	"_actual "
	"; "
	": cuda-read	( _adr _len -- _actual ) "
	"get-response "
	"nip "
	"; "
	"8 buffer: athens-data	\" \"(012250FFFF)\" athens-data swap move "
	"8 buffer: athens-rsp "
	": write-IIC	( -- ) "
	"athens-data 5 cuda-write drop "
	"athens-rsp 3 cuda-read drop "
	"; "
	": init-ATHENS	( P2Mux N2 D2 -- ) "
	"4 1 do "
	"i athens-data 3 + c! ( val ) athens-data 4 + c! "
	"( athens-data 5 dump cr ) "
	"write-IIC "
	"loop "
	"; "
	": ping-CONTROL	( enable-bit -- ) "
	"5 ms "
	"dup 8 or swap "
	"dup regs >C.TEST rl! 5 ms "
	"swap dup regs >C.TEST rl! 5 ms "
	"swap dup regs >C.TEST rl! 5 ms "
	"swap dup regs >C.TEST rl! 5 ms "
	"2drop "
	"; "
	": reset-CONTROL "
	"h# 433 ping-CONTROL "
	"1 regs >C.GSC-DIVIDE rl! "
	"; "
	": enable-CONTROL "
	"h# 033 ping-CONTROL "
	"; "
	": init-CONTROL	( tbl-ptr -- ) "
	"-1 to bankb? "
	"phys-fb-address dup h# 1000 _I_G do-map "
	"h# 31 regs >C.ENABLE rl! "
	"h# 12345678 phys-fb-address rl! "
	"regs >C.ENABLE rl@ drop "
	"h# 12345678 phys-fb-address rl@ <> "
	"phys-fb-address h# 1000 do-unmap "
	"if "
	"0 to bankb? "
	"phys-fb-address h# 600000 or to phys-fb-address "
	"then "
	"dup @ ( dup .h ) lbsplit init-ATHENS init-RADACAL cell+ "
	"d# 16 0 do "
	"w@++ ( dup .d ) regs >C.VFPEQ i 4 << + ( dup .h cr ) rl! "
	"loop "
	"w@++	regs >C.GSC-DIVIDE rl! "
	"w@++ dup to width	regs >C.ROW-WORDS rl! "
	"w@ to height "
	"h# 31 bankB? not 8 and or "
	"little? 2 and or	regs >C.ENABLE rl! "
	"0		regs >C.GBASE rl! "
	"h# 01e4	regs >C.REFRESH-COUNT rl! "
	"0		regs >C.INT-ENABLE rl! "
	"; "
	": my-open "
	"\" assigned-addresses\" get-my-property "
	"abort\" no REG property\"	( prop-adr prop-len ) "
	"begin "
	"dup 0> while "
	"decode-int h# FF and >r decode-int drop decode-int >r "
	"8 - swap 8 + swap							( prop-adr prop-len ) "
	"r> r> case "
	"h# 14 of "
	"to phys-regs "
	"endof "
	"h# 18 of "
	"h# 00800000 + to phys-fb-address "
	"endof "
	"swap drop "
	"endcase "
	"repeat "
	"2drop "
	"phys-regs 0 my-space h# 02000000 or h# 1000 \" map-in\" $call-parent to regs "
	"reset-CONTROL "
	"mon-sense "
	"get-mode swap to mono-mode? "
	"( mode-dependent-table-addr ) "
	"dup 0= if "
	"abort "
	"then "
	"( mode-dependent-table-addr ) "
	"init-CONTROL "
	"std-16 0 d# 16 set-colors "
	"enable-CONTROL "
	"phys-fb-address 0 my-space h# 02000000 or width height * \" map-in\" $call-parent to fb-address "
	"fb-address width height * 7 fill "
	"default-font set-font "
	"width height over 20 - char-width / over 20 - char-height / fb8-install "
	"width #columns char-width * - 2/ to window-left "
	"height #lines char-height * - 2/ to window-top "
	"fb-address to frame-buffer-adr "
	"width encode-int \" width\" property "
	"height encode-int \" height\" property "
	"width encode-int \" linebytes\" property "
	"8 encode-int \" depth\" property "
	"; "
	": my-close "
	"fb-address height width * \" map-out\" $call-parent "
	"regs h# 1000 \" map-out\" $call-parent "
	"; "
	"EXTERNAL "
	": DIMENSIONS "
	"width height "
	"; "
	": SET-COLORS	( adr index #indices ) "
	"swap RAD-REG-ADDR! "
	"( #indices ) 0 ?do				( adr ) "
	"mono-mode? if "
	"c+ h# 4d * >r				( red adr ) "
	"c+ h# 97 * >r				( red green adr ) "
	"c+ h# 1c * 					( red green blue adr ) "
	"r> + r> + 8 >>				( luminance ) "
	"do-gamma "
	"dup "
	"dup "
	"CLUT! "
	"( adr ) "
	"else "
	"c+ do-gamma swap			( R adr ) "
	"c+ do-gamma swap			( R G adr ) "
	"c+ do-gamma swap  			( R G B adr ) "
	">r swap rot CLUT! r>		( B G R ) "
	"then "
	"loop						( adr ) "
	"drop "
	"; "
	": GET-COLORS	( adr index #indices -- ) "
	"swap ( index ) RAD-REG-ADDR! ( #indices )  0 ?do "
	"CLUT@ anti-gamma >r anti-gamma >r anti-gamma		( R ) "
	"c!+ r> c!+ r> c!+ "
	"loop "
	"drop "
	"; "
	": COLOR!		( r g b index -- ) "
	">r RGB-temp 2+ c! RGB-temp 1+ c! RGB-temp c! "
	"RGB-temp r> 1 set-colors "
	"; "
	": COLOR@		( index -- r g b ) "
	"RGB-temp swap 1 get-colors "
	"RGB-temp c+ swap c+ swap c@ "
	"; "
	": rect-setup	( adr|index x y w h -- w adr|index xy-adr h ) "
	">r >r width * + fb-address + r> -rot r> "
	"; "
	": DRAW-RECTANGLE	( adr x y w h -- ) "
	"rect-setup "
	"( h ) 0 ?do								( w adr xy-adr ) "
	"2dup 4 pick move "
	"2 pick width d+ "
	"loop "
	"3drop "
	"; "
	": FILL-RECTANGLE	( index x y w h -- ) "
	"rect-setup 								( w index xy-adr h ) "
	"( h ) 0 ?do								( w index xy-adr ) "
	"dup 3 pick 3 pick fill "
	"width + "
	"loop "
	"3drop "
	"; "
	": READ-RECTANGLE	( adr x y w h -- ) "
	"rect-setup  >r swap r>					( w xy-adr adr h ) "
	"( h ) 0 ?do "
	"2dup 4 pick move "
	"width 3 pick d+ "
	"loop "
	"3drop "
	"; "
	"['] my-open is-install "
	"['] my-close is-remove "
,
 " device-end",0};