'''Translucent boxes supplement for my vector article '''SetVideoSeg by Plasma 'Relsoft 2004 DECLARE SUB GradColor (col1%, r1%, g1%, b1%, col2%, r2%, g2%, b2%) DECLARE SUB TransBox (x1%, y1%, x2%, y2%, clr%) DECLARE SUB AF.Print (Xpos%, Ypos%, Text$, col%) DECLARE SUB SetVideoSeg (Segment%) DEFINT A-Z RANDOMIZE TIMER REDIM Vpage(32009) AS INTEGER ' Clear offscreen buffer Vpage(6) = 2560 Vpage(7) = 200 Layer = VARSEG(Vpage(0)) + 1 CLS SCREEN 13 'Read ending grad colors and set gradient pal RESTORE RGB FOR i = 0 TO 15 READ R%, g%, B% GradColor i * 16, 0, 0, 0, (i * 16) + 15, R%, g%, B% NEXT i ''draw an example of the 16 color gradient pal in 16 rows AF.Print 100, 20, "This is the PAL in 16", 23 AF.Print 100, 30, "color grad(arranged).", 23 FOR i = 0 TO 15 FOR j = 0 TO 15 LINE (j * 5, i * 5)-STEP(5, 5), (i * 16) + j, BF NEXT j NEXT i ''Draw continous lines AF.Print 0, 100, "This is whole 256 colors sequentially.", 23 FOR i = 0 TO 255 LINE (i, 120)-STEP(0, 50), i, BF NEXT i C$ = INPUT$(1) CLS x1 = 50 y1 = 50 x2 = x1 + 100 y2 = y1 + 100 clr = 15 + (RND * 240) DIM Bg(32001) AS INTEGER 'Backgroud FOR y = 20 TO 199 'draw some nice BG FOR x = 0 TO 319 PSET (x, y), x XOR y NEXT x NEXT y GET (0, 0)-(319, 199), Bg DO x2 = x1 + 100 y2 = y1 + 100 SetVideoSeg Layer LINE (0, 0)-(319, 199), 0, BF 'cls PUT (0, 0), Bg, PSET 'BG AF.Print 0, 0, "Use arrows to move box.", 150 AF.Print 0, 10, "Space to change color(Color=" + STR$(clr) + ")", 40 K$ = INKEY$ SELECT CASE K$ CASE CHR$(0) + "H" y1 = y1 - 1 CASE CHR$(0) + "P" y1 = y1 + 1 CASE CHR$(0) + "K" x1 = x1 - 1 CASE CHR$(0) + "M" x1 = x1 + 1 CASE CHR$(32) clr = (clr + 1) AND 255'Rotate color CASE ELSE END SELECT TransBox x1, y1, x2, y2, clr SetVideoSeg &HA000 PUT (0, 0), Vpage(6), PSET LOOP UNTIL K$ = CHR$(27) END 'RGB colors for our Grad RGB: DATA 63,63,63 : 'WHITE DATA 63,0,0 : 'RED DATA 0,63,0 : 'GREEN DATA 0,0,63 : 'BLUE DATA 0,63,63 : 'BLUE/GREEN DATA 63,63,0 : 'RED/GREEN DATA 63,0,63 : 'RED/BLUE DATA 32,25,63 : ' DATA 63,0,45 : ' DATA 16,63,20 : ' DATA 45,45,63 : ' DATA 63,45,20 : ' DATA 25,63,45 : ' DATA 56,63,34 : ' DATA 45,25,50 : ' DATA 63,25,11 : ' SUB AF.Print (Xpos%, Ypos%, Text$, col%) 'Prints the standard 8*8 CGA font 'Paramenters: 'Segment=the Layer to print to 'Xpos,Ypos=the coordinates of the text 'Text$=the string to print 'col= is the color to print(gradient) x% = Xpos% y% = Ypos% Spacing% = 8 FOR i% = 0 TO LEN(Text$) - 1 x% = x% + Spacing% Offset% = 8 * ASC(MID$(Text$, i% + 1, 1)) + 14 FOR j% = 0 TO 7 DEF SEG = &HFFA6 Bit% = PEEK(Offset% + j%) IF Bit% AND 1 THEN PSET (x%, y% + j%), col% + j% IF Bit% AND 2 THEN PSET (x% - 1, y% + j%), col% + j% IF Bit% AND 4 THEN PSET (x% - 2, y% + j%), col% + j% IF Bit% AND 8 THEN PSET (x% - 3, y% + j%), col% + j% IF Bit% AND 16 THEN PSET (x% - 4, y% + j%), col% + j% IF Bit% AND 32 THEN PSET (x% - 5, y% + j%), col% + j% IF Bit% AND 64 THEN PSET (x% - 6, y% + j%), col% + j% IF Bit% AND 128 THEN PSET (x% - 7, y% + j%), col% + j% NEXT j% NEXT i% END SUB SUB GradColor (col1, r1, g1, b1, col2, r2, g2, b2) 'Makes a gradient color by interpolating the RGB values of the first 'color index (col1) and col2 by the number of cols. 'Only use this in screen 13 R! = r1 g! = g1 B! = b1 cols = (col2 - col1 + 1) Rstep! = (r2 - r1 + 1) / cols Gstep! = (g2 - g1 + 1) / cols Bstep! = (b2 - b1 + 1) / cols FOR col = col1 TO col2 R! = R! + Rstep! g! = g! + Gstep! B! = B! + Bstep! IF R! > 63 THEN R! = 63 IF R! < 0 THEN R! = 0 IF g! > 63 THEN g! = 63 IF g! < 0 THEN g! = 0 IF B! > 63 THEN B! = 63 IF B! < 0 THEN B! = 0 OUT &H3C8, col OUT &H3C9, FIX(R!) OUT &H3C9, FIX(g!) OUT &H3C9, FIX(B!) NEXT col END SUB SUB SetVideoSeg (Segment) STATIC DEF SEG IF VideoAddrOff& = 0 THEN ' First time the sub is called ' We need to find the location of b$AddrC, which holds the graphics ' offset (b$OffC) and segment (b$SegC). Since b$AddrC is in the default ' segment, we can find it by setting it to a certain value, and then ' searching for that value. SCREEN 13 ' Set b$SegC to A000 (00A0 in memory) PSET (160, 100), 0 ' Set b$OffC to 7DA0 (not needed in the IDE) FOR Offset& = 0 TO 32764 ' Search for b$AddrC, which is IF PEEK(Offset&) = &HA0 THEN ' in the default segment and IF PEEK(Offset& + 1) = &H7D THEN ' should have a value of IF PEEK(Offset& + 2) = &H0 THEN ' A0 7D 00 A0. IF PEEK(Offset& + 3) = &HA0 THEN VideoAddrOff& = Offset& + 2 ' If we found it, record the EXIT FOR ' offset of b$SegC and quit END IF ' looking. (Oddly, changing END IF ' the b$OffC doesn't seem to END IF ' do anything, so this is why END IF ' this sub only changes b$SegC) NEXT END IF ' Change b$SegC to the specified Segment POKE VideoAddrOff&, Segment AND &HFF POKE VideoAddrOff& + 1, (Segment AND &HFF00&) \ &H100 END SUB SUB TransBox (x1, y1, x2, y2, clr) bx1 = x1 'save values in temp vars(BYVAL emulation) bx2 = x2 by1 = y1 by2 = y2 'Swap values if necessary IF bx1 > bx2 THEN SWAP bx1, bx2 IF by1 > by2 THEN SWAP by1, by2 TempC = clr AND 15 'and color of box by 15 BaseColor = clr - TempC 'get basecolor FOR ya = by1 TO by2 FOR xa = bx1 TO bx2 DestCol = POINT(xa, ya) AND 15 'and screen color by 15 C = ((TempC + DestCol) \ 2) + BaseColor 'average and add 'to base color PSET (xa, ya), C 'plot NEXT xa NEXT ya END SUB