100 'PALVIEW.BAS John Schnell May 1986
110 '
120 '
130 '----- set screen (reset palette to normal colors)
140 '
150 SCREEN 2: SCREEN 0: WIDTH 80: COLOR 7,0,0:LOCATE ,,0:CLS
160 '
170 GOSUB 10020                                 'install SETCLR subroutine
180 '
190 '----- setup up display
200 '
210 LOCATE 15,25: COLOR 15: PRINT "push any key for next palette";
220 LOCATE 11,27:           PRINT "text color values";
230 LOCATE  5,71:           PRINT "background";
240 LOCATE  1,1
250 '
260 '----- show attributes in hex values: text/bkgnd groups
270 '
280 FOR BKGND = 0 TO 7
290   FOR TEXT = 0 TO 15
300   COLOR TEXT,BKGND: PRINT USING " !! ";(HEX$(TEXT)),(HEX$(BKGND));
310 NEXT:PRINT:NEXT
320 '
330 '----- loop to cycle through new color groups inserted into palette
340 '
350 I$ = INPUT$(1): IF I$ = CHR$(27) THEN 460   'wait for key push
360 CBASE% = (CBASE% + 1) MOD 64                'bump color base value
370 FOR REG% = 0 TO 15                          'loop to update palette
380   CLR% = (CBASE% + REG%) MOD 64             'base color plus offset
390   GOSUB 10120                               'call SETCLR to update palette
400                                             'update display color codes
410   COLOR REG%,0: LOCATE 10,1+REG%*4: PRINT USING "###";CLR%;
420   IF REG% < 8 THEN LOCATE REG%+1,67: PRINT USING "###";CLR%;
430 NEXT
440 GOTO 350                                    'loop to pause
450 '
460 SCREEN 2: SCREEN 0                          'reset palette
470 END
480 '
10000 ' ----- Load subroutine: setclr
10010 '
10020 L% = 0: BYTE% = 0: POINTER% = 0                    'define variables
10030 DIM SETCLR%( 30)                                   'array to store sub
10040 RESTORE  10220                                     'set data pointer
10050 FOR L% = 0 TO  57                                  'loop to load subr
10060   READ BYTE%: POKE VARPTR(SETCLR%(0)) + L%,BYTE%   'load 1 byte
10070 NEXT
10080 RETURN
10090 '
10100 '----- Call subroutine: setclr
10110 '
10120 DEF SEG
10130 POINTER% = VARPTR(SETCLR%(0))
10140 '----- Interpretive BASIC call:
10160  CALL POINTER%(REG%,CLR%): RETURN
10210 '----- data for setclr
10220 DATA &H55, &H8B, &HEC, &H8B, &H76, &H08, &H8B, &H04, &H3D, &H0f
10230 DATA &H00, &H7F, &H21, &H3D, &H00, &H00, &H7C, &H1C, &H8A, &HD8
10240 DATA &H8B, &H76, &H06, &H8B, &H04, &H3D, &H3F, &H00, &H7F, &H10
10250 DATA &H3D, &H00, &H00, &H7C, &H0B, &H8A, &HF8, &HB4, &H10, &HB0
10260 DATA &H00, &HCD, &H10, &HEB, &H09, &H90, &HB8, &HFF, &HFF, &H8B
10270 DATA &H76, &H06, &H89, &H04, &H5D, &HCA, &H04, &H00