Initial revision
[ssr] / StraySrc / Sculptrix / sculptrix / s / slab
1 ;
2 ; slab.s
3 ;
4 ; Icon slabbing for Sculptrix
5 ;
6 ; © 1995-1998 Straylight
7 ;
8
9 ;----- Licensing note -------------------------------------------------------
10 ;
11 ; This file is part of Straylight's Sculptrix.
12 ;
13 ; Sculptrix is free software; you can redistribute it and/or modify
14 ; it under the terms of the GNU General Public License as published by
15 ; the Free Software Foundation; either version 2, or (at your option)
16 ; any later version.
17 ;
18 ; Sculptrix is distributed in the hope that it will be useful,
19 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ; GNU General Public License for more details.
22 ;
23 ; You should have received a copy of the GNU General Public License
24 ; along with Sculptrix. If not, write to the Free Software Foundation,
25 ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
27 ;----- Standard header ------------------------------------------------------
28
29 GET libs:header
30 GET libs:swis
31
32 GET libs:stream
33
34 ;----- External dependencies ------------------------------------------------
35
36 GET sh.colours
37 GET sh.plot
38 GET sh.vString
39 GET sh.wSpace
40
41 ;----- Main code ------------------------------------------------------------
42
43 AREA |Module$$Code|,CODE,READONLY
44
45 ; --- slab_doSlab ---
46 ;
47 ; On entry: R0 == window handle
48 ; R1 == icon handle
49 ; R2 == new background colour for icon
50 ;
51 ; On exit: R2 == old background colour, or -1
52 ;
53 ; Use: Low-level slabbing operation.
54
55 EXPORT slab_doSlab
56 slab_doSlab ROUT
57
58 STMFD R13!,{R0-R5,R14} ;Save some registers
59 MOV R14,#-1 ;Nothing achieved yet
60 STR R14,[R13,#8] ;Store as old colour
61
62 ; --- Read the icon information ---
63
64 SUB R13,R13,#84 ;Enough for a redraw block
65 STMIA R13,{R0,R1} ;Store the window and icon
66 MOV R1,R13 ;Point to this block
67 SWI XWimp_GetIconState ;Read the icon information
68 BVS %99slab_doSlab ;If that failed, return
69
70 ADD R1,R13,#8 ;Point to the icon data
71 BL vString_read ;Read the border information
72 BCC %90slab_doSlab ;No border -- return now
73 TST R0,#vsFlag_slab ;Is the border slabbable?
74 BEQ %90slab_doSlab ;Not slabbable -- return
75 BIC R5,R0,#&FF ;Clear to raw plinth
76
77 ; --- Swap the colours over ---
78
79 MOV R1,R13 ;Point to the full block
80 BL colours_set ;Set the background colour
81 STR R2,[R13,#84+8] ;Store this to return in R2
82
83 ; --- Now toggle the border ---
84
85 LDRB R14,[R4,#0] ;Load the invert character
86 EOR R14,R14,#&20 ;Change its case
87 STRB R14,[R4,#0] ;Store the character back
88
89 ADD R14,R13,#8 ;Point to the bounding box
90 LDMIA R14,{R2-R4,R14} ;Load these values out
91 SUB R2,R2,#4 ;Expand to allow for border
92 SUB R3,R3,#4
93 ADD R4,R4,#4
94 ADD R14,R14,#4
95 LDR R0,[R13,#0] ;Load the window handle
96 ADD R1,R13,#40 ;Point to the update block
97 STMIA R1,{R0,R2-R4,R14} ;Store them back again
98
99 SWI XWimp_UpdateWindow ;Start the update operation
100 BVS %99slab_doSlab ;If that failed, return
101 CMP R0,#0 ;Is there anything to do?
102 BEQ %90slab_doSlab ;No -- do nothing then
103
104 ; --- Read the window origin position ---
105
106 LDR R2,[R1,#4] ;Load the x0 coordinate
107 ADD R14,R1,#16 ;Find the others
108 LDMIA R14,{R3,R4,R14} ;Load them from the block
109 SUB R2,R2,R4 ;Find the x origin
110 SUB R3,R3,R14 ;And find the y origin
111
112 ; --- Do the update loop ---
113
114 00 EOR R0,R5,#vsFlag_invert ;Get the border type word
115 ADD R1,R13,#8 ;Point to the icon data
116 BL plot_border ;Go and plot the border
117 ADDVC R1,R13,#40 ;Point to the update block
118 SWIVC XWimp_GetRectangle ;Get another rectangle
119 BVS %99slab_doSlab ;If that failed, return
120 CMP R0,#0 ;Is that all there is?
121 BNE %b00 ;No -- loop back then
122
123 ; --- Tidy up and return ---
124
125 90slab_doSlab ADD R13,R13,#84 ;Restore the stack pointer
126 LDMFD R13!,{R0-R5,R14} ;Restore registers
127 BICS PC,R14,#V_flag ;And return without error
128
129 99slab_doSlab ADD R13,R13,#84+4 ;Restore the stack pointer
130 LDMFD R13!,{R1-R5,R14} ;Restore registers except R0
131 ORRS PC,R14,#V_flag ;And return the error
132
133 LTORG
134
135 ; --- slab_slab ---
136 ;
137 ; On entry: R0 == window handle
138 ; R1 == icon handle
139 ; R2 == pointer to slab descriptor block
140 ;
141 ; On exit: --
142 ;
143 ; Use: Slabs an icon in, and records information for unslabbing.
144
145 EXPORT slab_slab
146 slab_slab ROUT
147
148 STMFD R13!,{R0-R3,R14} ;Save some registers
149
150 ; --- Fill in the descriptor block ---
151
152 MOV R3,R2 ;Remember this pointer
153 STMIA R3,{R0,R1} ;Store them away
154 SWI XOS_ReadMonotonicTime ;Read the time
155 STR R0,[R3,#12] ;Store it in the block
156
157 ; --- Do the slabness ---
158
159 LDR R0,[R3,#0] ;Load the window handle
160 LDR R2,sculpt_slab ;Get the slab colour
161 BL slab_doSlab ;Do the slabbing op
162 BVS %99slab_slab
163
164 SUB R13,R13,#20 ;Allow some space for block
165 MOV R1,R13 ;Point to the block
166 SWI XWimp_GetPointerInfo ;Fetch the mouse status
167 LDR R14,[R13,#8] ;Fetch the button state
168 ADD R13,R13,#20 ;Restore the stack pointer
169 CMP R14,#0 ;Are any buttons pressed?
170 ORREQ R2,R2,#&100 ;No -- set a flag then
171 STR R2,[R3,#8] ;Store in the descriptor
172
173 ; --- Clear the `immediate unslab' flag ---
174
175 LDR R14,sculpt_flags ;Load the flags word
176 BIC R14,R14,#scFlag_unslab ;Clear the flag
177 STR R14,sculpt_flags ;Store the flags back
178 LDMFD R13!,{R0-R3,PC}^ ;Return when done
179
180 99 ADD R13,R13,#4 ;Don't restore R0 on exit
181 LDMFD R13!,{R1-R3,R14} ;Restore other registers
182 ORRS PC,R14,#V_flag ;And return with V set
183
184 LTORG
185
186 ; --- slab_unslab ---
187 ;
188 ; On entry: R2 == pointer to descriptor block
189 ;
190 ; On exit: --
191 ;
192 ; Use: Unslabs an icon which was slabbed.
193
194 EXPORT slab_unslab
195 slab_unslab ROUT
196
197 STMFD R13!,{R0-R4,R14} ;Save some registers
198 MOV R4,R2 ;Move this somewhere nice
199
200 ; --- Quick check to see if anything needs doing ---
201
202 LDR R14,[R4,#8] ;Load the colour word
203 CMP R14,#-1 ;Is this unset?
204 BEQ %90slab_unslab ;Yes -- return then
205
206 ; --- Do we do this quickly? ---
207
208 LDR R14,sculpt_flags ;Load the flags word
209 TST R14,#scFlag_unslab ;Have we recently unslabbed?
210 BNE %50slab_unslab ;Yes -- skip the delay
211 ORR R14,R14,#scFlag_unslab ;Set the flag now
212 STR R14,sculpt_flags ;Save the flags back
213
214 ; --- Work out how long to wait ---
215
216 SUB R13,R13,#36 ;Make space for a block
217 LDR R14,[R4,#0] ;Load the window handle
218 STR R14,[R13,#0] ;Store in the block
219 MOV R1,R13 ;Point to my block
220 SWI XWimp_GetWindowState ;Read the window state
221 MOVVS R14,#0 ;If failed, assume deleted
222 LDRVC R14,[R13,#32] ;Else load the window flags
223 ADD R13,R13,#36 ;Restore the stack pointer
224 TST R14,#&00010000 ;Is the window open?
225 BEQ %10slab_unslab ;Yes -- wait for timer then
226
227 LDR R14,[R4,#8] ;Load the flags/colour word
228 TST R14,#&100 ;Is the `no mouse' bit set?
229 BNE %10slab_unslab ;Yes -- wait for timer then
230
231 ; --- Check for the mouse then ---
232
233 00 SWI XOS_Mouse ;Read the mouse position
234 CMP R2,#0 ;Are the buttons released?
235 BNE %b00 ;No -- skip round
236 B %50slab_unslab ;Now skip onwards for unslab
237
238 ; --- Check for the timer ---
239
240 10slab_unslab LDR R1,[R4,#12] ;Load the targt time
241 ADD R1,R1,#10 ;Allow a tenth of a second
242 00 SWI XOS_ReadMonotonicTime ;Read the current time
243 CMP R0,R1 ;Have we waited long enough?
244 BMI %b00 ;No -- loop back then
245
246 ; --- Now we can unslab the icon ---
247
248 50slab_unslab LDMIA R4,{R0-R2} ;Load the information out
249 AND R2,R2,#&FF ;Only use the colour bits
250 BL slab_doSlab ;Do the unslabbing
251
252 90 LDMFD R13!,{R0-R4,PC}^ ;Return to caller when done
253
254 99 ADD R13,R13,#4 ;Don't restore R0 on exit
255 LDMFD R13!,{R1-R4,R14} ;Restore registers
256 ORRS PC,R14,#V_flag ;And return to caller
257
258 LTORG
259
260 ; --- slab_colour ---
261 ;
262 ; On entry: --
263 ;
264 ; On exit: R2 == slab colour
265 ;
266 ; Use: Returns the current slabbing colour.
267
268 EXPORT slab_colour
269 slab_colour ROUT
270
271 LDR R2,sculpt_slab ;Load the slabbing colour
272 MOVS PC,R14 ;And return to caller
273
274 LTORG
275
276 ;----- That's all, folks ----------------------------------------------------
277
278 END