Creating Draggable Windows in Open Firmware

\ Open Firmware Windows Demo \ Copyright (c) Amit Singh. All Rights Reserved. \ http://osxbook.com \ Commentary required for "booting" this program. decimal 16 value m-w 16 value m-h m-w m-h * value m-dim m-dim buffer: smask m-dim buffer: cmask m-dim buffer: scrnbg m-dim buffer: oldbg : load-cmask ( -- ) 0 cmask 0 + c! 0 cmask 1 + c! 0 cmask 2 + c! 0 cmask 3 + c! 0 cmask 4 + c! 0 cmask 5 + c! 0 cmask 6 + c! 0 cmask 7 + c! 0 cmask 8 + c! 0 cmask 9 + c! 0 cmask 10 + c! 0 cmask 11 + c! 0 cmask 12 + c! 0 cmask 13 + c! 0 cmask 14 + c! 0 cmask 15 + c! 0 cmask 16 + c! 0 cmask 17 + c! 1 cmask 18 + c! 0 cmask 19 + c! 0 cmask 20 + c! 0 cmask 21 + c! 0 cmask 22 + c! 0 cmask 23 + c! 0 cmask 24 + c! 0 cmask 25 + c! 0 cmask 26 + c! 0 cmask 27 + c! 0 cmask 28 + c! 0 cmask 29 + c! 0 cmask 30 + c! 0 cmask 31 + c! 0 cmask 32 + c! 0 cmask 33 + c! 1 cmask 34 + c! 1 cmask 35 + c! 0 cmask 36 + c! 0 cmask 37 + c! 0 cmask 38 + c! 0 cmask 39 + c! 0 cmask 40 + c! 0 cmask 41 + c! 0 cmask 42 + c! 0 cmask 43 + c! 0 cmask 44 + c! 0 cmask 45 + c! 0 cmask 46 + c! 0 cmask 47 + c! 0 cmask 48 + c! 0 cmask 49 + c! 1 cmask 50 + c! 1 cmask 51 + c! 1 cmask 52 + c! 0 cmask 53 + c! 0 cmask 54 + c! 0 cmask 55 + c! 0 cmask 56 + c! 0 cmask 57 + c! 0 cmask 58 + c! 0 cmask 59 + c! 0 cmask 60 + c! 0 cmask 61 + c! 0 cmask 62 + c! 0 cmask 63 + c! 0 cmask 64 + c! 0 cmask 65 + c! 1 cmask 66 + c! 1 cmask 67 + c! 1 cmask 68 + c! 1 cmask 69 + c! 0 cmask 70 + c! 0 cmask 71 + c! 0 cmask 72 + c! 0 cmask 73 + c! 0 cmask 74 + c! 0 cmask 75 + c! 0 cmask 76 + c! 0 cmask 77 + c! 0 cmask 78 + c! 0 cmask 79 + c! 0 cmask 80 + c! 0 cmask 81 + c! 1 cmask 82 + c! 1 cmask 83 + c! 1 cmask 84 + c! 1 cmask 85 + c! 1 cmask 86 + c! 0 cmask 87 + c! 0 cmask 88 + c! 0 cmask 89 + c! 0 cmask 90 + c! 0 cmask 91 + c! 0 cmask 92 + c! 0 cmask 93 + c! 0 cmask 94 + c! 0 cmask 95 + c! 0 cmask 96 + c! 0 cmask 97 + c! 1 cmask 98 + c! 1 cmask 99 + c! 1 cmask 100 + c! 1 cmask 101 + c! 1 cmask 102 + c! 1 cmask 103 + c! 0 cmask 104 + c! 0 cmask 105 + c! 0 cmask 106 + c! 0 cmask 107 + c! 0 cmask 108 + c! 0 cmask 109 + c! 0 cmask 110 + c! 0 cmask 111 + c! 0 cmask 112 + c! 0 cmask 113 + c! 1 cmask 114 + c! 1 cmask 115 + c! 1 cmask 116 + c! 1 cmask 117 + c! 1 cmask 118 + c! 1 cmask 119 + c! 1 cmask 120 + c! 0 cmask 121 + c! 0 cmask 122 + c! 0 cmask 123 + c! 0 cmask 124 + c! 0 cmask 125 + c! 0 cmask 126 + c! 0 cmask 127 + c! 0 cmask 128 + c! 0 cmask 129 + c! 1 cmask 130 + c! 1 cmask 131 + c! 1 cmask 132 + c! 1 cmask 133 + c! 1 cmask 134 + c! 1 cmask 135 + c! 1 cmask 136 + c! 1 cmask 137 + c! 0 cmask 138 + c! 0 cmask 139 + c! 0 cmask 140 + c! 0 cmask 141 + c! 0 cmask 142 + c! 0 cmask 143 + c! 0 cmask 144 + c! 0 cmask 145 + c! 1 cmask 146 + c! 1 cmask 147 + c! 1 cmask 148 + c! 1 cmask 149 + c! 1 cmask 150 + c! 0 cmask 151 + c! 0 cmask 152 + c! 0 cmask 153 + c! 0 cmask 154 + c! 0 cmask 155 + c! 0 cmask 156 + c! 0 cmask 157 + c! 0 cmask 158 + c! 0 cmask 159 + c! 0 cmask 160 + c! 0 cmask 161 + c! 1 cmask 162 + c! 1 cmask 163 + c! 0 cmask 164 + c! 1 cmask 165 + c! 1 cmask 166 + c! 0 cmask 167 + c! 0 cmask 168 + c! 0 cmask 169 + c! 0 cmask 170 + c! 0 cmask 171 + c! 0 cmask 172 + c! 0 cmask 173 + c! 0 cmask 174 + c! 0 cmask 175 + c! 0 cmask 176 + c! 0 cmask 177 + c! 1 cmask 178 + c! 0 cmask 179 + c! 0 cmask 180 + c! 0 cmask 181 + c! 1 cmask 182 + c! 1 cmask 183 + c! 0 cmask 184 + c! 0 cmask 185 + c! 0 cmask 186 + c! 0 cmask 187 + c! 0 cmask 188 + c! 0 cmask 189 + c! 0 cmask 190 + c! 0 cmask 191 + c! 0 cmask 192 + c! 0 cmask 193 + c! 0 cmask 194 + c! 0 cmask 195 + c! 0 cmask 196 + c! 0 cmask 197 + c! 1 cmask 198 + c! 1 cmask 199 + c! 0 cmask 200 + c! 0 cmask 201 + c! 0 cmask 202 + c! 0 cmask 203 + c! 0 cmask 204 + c! 0 cmask 205 + c! 0 cmask 206 + c! 0 cmask 207 + c! 0 cmask 208 + c! 0 cmask 209 + c! 0 cmask 210 + c! 0 cmask 211 + c! 0 cmask 212 + c! 0 cmask 213 + c! 0 cmask 214 + c! 1 cmask 215 + c! 1 cmask 216 + c! 0 cmask 217 + c! 0 cmask 218 + c! 0 cmask 219 + c! 0 cmask 220 + c! 0 cmask 221 + c! 0 cmask 222 + c! 0 cmask 223 + c! 0 cmask 224 + c! 0 cmask 225 + c! 0 cmask 226 + c! 0 cmask 227 + c! 0 cmask 228 + c! 0 cmask 229 + c! 0 cmask 230 + c! 1 cmask 231 + c! 1 cmask 232 + c! 0 cmask 233 + c! 0 cmask 234 + c! 0 cmask 235 + c! 0 cmask 236 + c! 0 cmask 237 + c! 0 cmask 238 + c! 0 cmask 239 + c! 0 cmask 240 + c! 0 cmask 241 + c! 0 cmask 242 + c! 0 cmask 243 + c! 0 cmask 244 + c! 0 cmask 245 + c! 0 cmask 246 + c! 0 cmask 247 + c! 0 cmask 248 + c! 0 cmask 249 + c! 0 cmask 250 + c! 0 cmask 251 + c! 0 cmask 252 + c! 0 cmask 253 + c! 0 cmask 254 + c! 0 cmask 255 + c! ; : load-smask ( -- ) 1 smask 0 + c! 0 smask 1 + c! 0 smask 2 + c! 1 smask 3 + c! 1 smask 4 + c! 1 smask 5 + c! 1 smask 6 + c! 1 smask 7 + c! 1 smask 8 + c! 1 smask 9 + c! 1 smask 10 + c! 1 smask 11 + c! 1 smask 12 + c! 1 smask 13 + c! 1 smask 14 + c! 1 smask 15 + c! 1 smask 16 + c! 0 smask 17 + c! 0 smask 18 + c! 0 smask 19 + c! 1 smask 20 + c! 1 smask 21 + c! 1 smask 22 + c! 1 smask 23 + c! 1 smask 24 + c! 1 smask 25 + c! 1 smask 26 + c! 1 smask 27 + c! 1 smask 28 + c! 1 smask 29 + c! 1 smask 30 + c! 1 smask 31 + c! 1 smask 32 + c! 0 smask 33 + c! 0 smask 34 + c! 0 smask 35 + c! 0 smask 36 + c! 1 smask 37 + c! 1 smask 38 + c! 1 smask 39 + c! 1 smask 40 + c! 1 smask 41 + c! 1 smask 42 + c! 1 smask 43 + c! 1 smask 44 + c! 1 smask 45 + c! 1 smask 46 + c! 1 smask 47 + c! 1 smask 48 + c! 0 smask 49 + c! 0 smask 50 + c! 0 smask 51 + c! 0 smask 52 + c! 0 smask 53 + c! 1 smask 54 + c! 1 smask 55 + c! 1 smask 56 + c! 1 smask 57 + c! 1 smask 58 + c! 1 smask 59 + c! 1 smask 60 + c! 1 smask 61 + c! 1 smask 62 + c! 1 smask 63 + c! 1 smask 64 + c! 0 smask 65 + c! 0 smask 66 + c! 0 smask 67 + c! 0 smask 68 + c! 0 smask 69 + c! 0 smask 70 + c! 1 smask 71 + c! 1 smask 72 + c! 1 smask 73 + c! 1 smask 74 + c! 1 smask 75 + c! 1 smask 76 + c! 1 smask 77 + c! 1 smask 78 + c! 1 smask 79 + c! 1 smask 80 + c! 0 smask 81 + c! 0 smask 82 + c! 0 smask 83 + c! 0 smask 84 + c! 0 smask 85 + c! 0 smask 86 + c! 0 smask 87 + c! 1 smask 88 + c! 1 smask 89 + c! 1 smask 90 + c! 1 smask 91 + c! 1 smask 92 + c! 1 smask 93 + c! 1 smask 94 + c! 1 smask 95 + c! 1 smask 96 + c! 0 smask 97 + c! 0 smask 98 + c! 0 smask 99 + c! 0 smask 100 + c! 0 smask 101 + c! 0 smask 102 + c! 0 smask 103 + c! 0 smask 104 + c! 1 smask 105 + c! 1 smask 106 + c! 1 smask 107 + c! 1 smask 108 + c! 1 smask 109 + c! 1 smask 110 + c! 1 smask 111 + c! 1 smask 112 + c! 0 smask 113 + c! 0 smask 114 + c! 0 smask 115 + c! 0 smask 116 + c! 0 smask 117 + c! 0 smask 118 + c! 0 smask 119 + c! 0 smask 120 + c! 0 smask 121 + c! 1 smask 122 + c! 1 smask 123 + c! 1 smask 124 + c! 1 smask 125 + c! 1 smask 126 + c! 1 smask 127 + c! 1 smask 128 + c! 0 smask 129 + c! 0 smask 130 + c! 0 smask 131 + c! 0 smask 132 + c! 0 smask 133 + c! 0 smask 134 + c! 0 smask 135 + c! 0 smask 136 + c! 0 smask 137 + c! 0 smask 138 + c! 1 smask 139 + c! 1 smask 140 + c! 1 smask 141 + c! 1 smask 142 + c! 1 smask 143 + c! 1 smask 144 + c! 0 smask 145 + c! 0 smask 146 + c! 0 smask 147 + c! 0 smask 148 + c! 0 smask 149 + c! 0 smask 150 + c! 0 smask 151 + c! 0 smask 152 + c! 0 smask 153 + c! 0 smask 154 + c! 0 smask 155 + c! 1 smask 156 + c! 1 smask 157 + c! 1 smask 158 + c! 1 smask 159 + c! 1 smask 160 + c! 0 smask 161 + c! 0 smask 162 + c! 0 smask 163 + c! 0 smask 164 + c! 0 smask 165 + c! 0 smask 166 + c! 0 smask 167 + c! 1 smask 168 + c! 1 smask 169 + c! 1 smask 170 + c! 1 smask 171 + c! 1 smask 172 + c! 1 smask 173 + c! 1 smask 174 + c! 1 smask 175 + c! 1 smask 176 + c! 0 smask 177 + c! 0 smask 178 + c! 0 smask 179 + c! 1 smask 180 + c! 0 smask 181 + c! 0 smask 182 + c! 0 smask 183 + c! 0 smask 184 + c! 1 smask 185 + c! 1 smask 186 + c! 1 smask 187 + c! 1 smask 188 + c! 1 smask 189 + c! 1 smask 190 + c! 1 smask 191 + c! 1 smask 192 + c! 0 smask 193 + c! 0 smask 194 + c! 1 smask 195 + c! 1 smask 196 + c! 0 smask 197 + c! 0 smask 198 + c! 0 smask 199 + c! 0 smask 200 + c! 1 smask 201 + c! 1 smask 202 + c! 1 smask 203 + c! 1 smask 204 + c! 1 smask 205 + c! 1 smask 206 + c! 1 smask 207 + c! 1 smask 208 + c! 1 smask 209 + c! 1 smask 210 + c! 1 smask 211 + c! 1 smask 212 + c! 1 smask 213 + c! 0 smask 214 + c! 0 smask 215 + c! 0 smask 216 + c! 0 smask 217 + c! 1 smask 218 + c! 1 smask 219 + c! 1 smask 220 + c! 1 smask 221 + c! 1 smask 222 + c! 1 smask 223 + c! 1 smask 224 + c! 1 smask 225 + c! 1 smask 226 + c! 1 smask 227 + c! 1 smask 228 + c! 1 smask 229 + c! 0 smask 230 + c! 0 smask 231 + c! 0 smask 232 + c! 0 smask 233 + c! 1 smask 234 + c! 1 smask 235 + c! 1 smask 236 + c! 1 smask 237 + c! 1 smask 238 + c! 1 smask 239 + c! 1 smask 240 + c! 1 smask 241 + c! 1 smask 242 + c! 1 smask 243 + c! 1 smask 244 + c! 1 smask 245 + c! 1 smask 246 + c! 0 smask 247 + c! 0 smask 248 + c! 0 smask 249 + c! 1 smask 250 + c! 1 smask 251 + c! 1 smask 252 + c! 1 smask 253 + c! 1 smask 254 + c! 1 smask 255 + c! ; \ Pointer variable m-oldx 0 m-oldx ! variable m-oldy 0 m-oldy ! variable goodptr false goodptr ! \ Window 160 value w-w 120 value w-h w-w w-h * buffer: wbuf w-w w-h * buffer: wbufbs variable w-oldx 100 w-oldx ! variable w-oldy 100 w-oldy ! variable todowin false todowin ! \ Button variable inbutton false inbutton ! variable bcleanup false bcleanup ! variable b_shutdown_x variable b_shutdown_y 0 value myscreen " screen" open-dev to myscreen 0 value mymouse " mouse" open-dev to mymouse 0 0 0 0 " color!" myscreen $call-method 255 255 255 1 " color!" myscreen $call-method : ofw-readrect ( addr x y w h -- ) " read-rectangle" myscreen $call-method ; : ofw-drawrect ( addr x y w h -- ) " draw-rectangle" myscreen $call-method ; : ofw-fillrect ( color x y w h -- ) " fill-rectangle" myscreen $call-method ; : ofw-getmevent ( msec -- pos.x pos.y buttons true|false ) " get-event" mymouse $call-method ; \ Font stuff ... \ Starts from (x, y) = (4 * 6, 6 + 6 + 11) = (24, 23) \ = \ _ok \ = \ 0_>_0123... \ \ ASCII 32 (sp) to 126 (~) decimal \ ." ! #$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~" cr cr 32 value ascii_min 126 value ascii_max char-height char-width * 8 * value fontsz variable fontbuffer 53248 alloc-mem fontbuffer ! 95 0 do fontbuffer @ fontsz i * + i char-width * 4 char-width char-height ofw-readrect loop erase-screen variable glstring variable glx variable gly : validate_char ( char -- char ) dup ascii_min < if drop ascii_min else dup ascii_max > if drop ascii_max then then ; : puts ( string x y -- ) gly ! glx ! 0 rot glstring ! do glstring @ i + c@ validate_char 32 - fontsz * fontbuffer @ + glx @ i char-width * + gly @ char-width char-height ofw-drawrect loop ; : isxin ( x1 x w -- bool ) 2 pick ( x1 x w x1 ) 2 pick ( x1 x w x1 x) < if 3drop false else ( x1 x w ) 2 pick ( x1 x w x1 ) \ 16 + 2 pick ( x1 x w x1 x ) 2 pick ( x1 x w x1 x w ) + \ width > if 3drop false else 3drop true then then ; : isin ( x1 y1 x y w h -- bool ) 5 pick ( x1 y1 x y w h x1 ) 4 pick ( x1 y1 x y w h x1 x ) 3 pick ( x1 y1 x y w h x1 x w ) isxin false = if 3drop 3drop false else 4 pick ( x1 y1 x y w h y1 ) 3 pick ( x1 y1 x y w h y1 y ) 2 pick ( x1 y1 x y w h y1 y h ) isxin false = if 3drop 3drop false else 3drop 3drop true then then ; : create-buttons ( -- ) screen-width 64 - 2 - b_shutdown_x ! screen-height 0 2 + b_shutdown_y ! 0 b_shutdown_x @ b_shutdown_y @ 64 24 ofw-fillrect 1 b_shutdown_x @ 1 + b_shutdown_y @ 1 + 62 22 ofw-fillrect " Shut Down" b_shutdown_x @ 2 + 3 + b_shutdown_y @ 6 + puts ; : create-window ( x y ) 2dup ( x y x y ) wbufbs -rot ( x y wbufbs x y ) w-w w-h ofw-readrect 2dup ( x y x y ) 0 -rot ( x y 1 x y ) w-w w-h ( x y 1 x y w-w w-h ) ofw-fillrect ( x y ) 2dup ( x y x y ) 1 -rot 2 + swap 2 + swap w-w 4 - 19 ofw-fillrect ( x y ) 2dup ( x y x y ) 0 -rot 4 + swap 4 + swap 15 15 ofw-fillrect ( x y ) 2dup ( x y x y ) 1 -rot 6 + swap 6 + swap 11 11 ofw-fillrect ( x y ) 2dup ( x y x y ) 1 -rot 23 + swap 2 + swap w-w 4 - w-h 25 - ofw-fillrect ( x y ) 2dup ( x y x y ) 0 -rot 24 + swap 3 + swap w-w 6 - w-h 27 - ofw-fillrect 5 1 do 2dup 0 -rot 4 i * + swap 23 + swap w-w 28 - 2 ofw-fillrect loop 2dup 1 -rot 32 + swap 6 + swap w-w 12 - char-height 3 * ofw-fillrect " Screen Resolution" 3 pick 3 pick 34 + swap 8 + swap puts screen-width (u.) ( x y s l ) 3 pick ( x y s l x ) 3 pick ( x y s l x y ) 36 + char-height + swap ( x y s l y' x ) 8 + swap ( x y s l x' y' ) puts " x " 3 pick 3 pick 36 + char-height + swap 8 + 4 char-width * + swap puts screen-height (u.) 3 pick 3 pick 36 + char-height + swap 8 + 7 char-width * + swap puts wbuf -rot w-w w-h ofw-readrect ; : ofwindows ( -- ) cr ." Press control-z to quit the Open Firmware Windows demo." cr load-cmask load-smask create-buttons oldbg m-oldx @ m-oldy @ m-w m-h ofw-readrect 100 100 create-window begin 0 ofw-getmevent true = ( pos.x pos.y buttons true|false true = ) if 0 = ( pos.x pos.y buttons 0 = ) if goodptr @ true = if true todowin ! then false goodptr ! 2dup ( pos.x pos.y ) m-oldy @ + swap m-oldx @ + swap b_shutdown_x @ b_shutdown_y @ 64 24 isin true = if inbutton @ false = if \ create border 0 b_shutdown_x @ b_shutdown_y @ 1 - 64 1 ofw-fillrect 0 b_shutdown_x @ b_shutdown_y @ 24 + 64 1 ofw-fillrect true inbutton ! then else inbutton @ true = if \ uncreate border 1 b_shutdown_x @ b_shutdown_y @ 1 - 64 1 ofw-fillrect 1 b_shutdown_x @ b_shutdown_y @ 24 + 64 1 ofw-fillrect false inbutton ! true bcleanup ! then then else 2dup ( pos.x pos.y ) m-oldy @ + swap m-oldx @ + swap b_shutdown_x @ b_shutdown_y @ 64 24 isin true = if shut-down then goodptr @ false = if 2dup ( pos.x pos.y pos.x pos.y ) m-oldy @ ( pos.x pos.y pos.x pos.y m-oldy ) + ( pos.x pos.y pos.x newy ) swap ( pos.x pos.y newy pos.x ) m-oldx @ ( pos.x pos.y newy pos.x m-oldx ) + ( pos.x pos.y newy newx ) swap ( pos.x pos.y newx newy ) w-oldx @ ( pos.x pos.y newx newy m-oldx ) w-oldy @ ( pos.x pos.y newx newy m-oldx m-oldy ) w-w ( pos.x pos.y newx newy m-oldx m-oldy w ) 20 ( pos.x pos.y newx newy m-oldx m-oldy w 20 ) isin ( pos.x pos.y tf? ) goodptr ! ( pos.x pos.y ) goodptr @ true = if true todowin ! else false todowin ! then then then oldbg ( pos.x pos.y oldbg ) m-oldx @ ( pos.x pos.y oldbg m-oldx ) m-oldy @ ( pos.x pos.y oldbg m-oldx m-oldy ) m-w ( pos.x pos.y oldbg m-oldx m-oldy m-w ) m-h ( pos.x pos.y oldbg m-oldx m-oldy m-w m-h ) ofw-drawrect ( pos.x pos.y ) bcleanup @ true = if 1 b_shutdown_x @ b_shutdown_y @ 1 - 64 1 ofw-fillrect 1 b_shutdown_x @ b_shutdown_y @ 24 + 64 1 ofw-fillrect false bcleanup ! then todowin @ true = if goodptr @ false = if false todowin ! then wbufbs w-oldx @ w-oldy @ w-w w-h ofw-drawrect 2dup w-oldy @ + swap w-oldx @ + swap 2dup w-oldy ! w-oldx ! wbufbs -rot w-w w-h ofw-readrect wbuf w-oldx @ w-oldy @ w-w w-h ofw-drawrect then 2dup ( pos.x pos.y pos.x pos.y ) oldbg ( pos.x pos.y pos.x pos.y oldbg ) -rot ( pos.x pos.y oldbg pos.x pos.y ) m-oldy @ + ( pos.x pos.y oldbg pos.x newy ) swap ( pos.x pos.y oldbg newy pos.x ) m-oldx @ + ( pos.x pos.y oldbg newy newx ) swap ( pos.x pos.y oldbg newx newy ) m-w m-h ( pos.x pos.y oldbg newx newy m-w m-h ) ofw-readrect ( pos.x pos.y ) m-dim 0 do oldbg i + c@ ( pos.x pos.y scrnbg[i] ) smask i + c@ ( pos.x pos.y scrnbg[i] ptrand[i] ) and ( pos.x pos.y s&p ) cmask i + c@ ( pos.x pos.y s&p ptrxor[i] ) xor ( pos.x pos.y s&p^P ) scrnbg i + c! ( pos.x pos.y ) loop scrnbg ( pos.x pos.y scrnbg ) -rot ( scrnbg pos.x pos.y ) m-oldy @ ( m-color-ptr pos.x pos.y m-oldy ) + ( m_color pos.x newy ) swap ( m-color-ptr newy pos.x ) m-oldx @ ( m-color-ptr newy pos.x m-oldx ) + ( m-color-ptr newy newx ) swap ( m-color-ptr newx newy ) 2dup ( m-color-ptr newx newy newx newy ) m-oldy ! ( m-color-ptr newx newy newx ) m-oldx ! ( m-color-ptr newx newy ) m-w m-h ( m-color-ptr newx newy m-w m-h ) ofw-drawrect then again ;