'=========================================================================== ' Subject: CGA 136 COLOUR MODE Date: 06-14-93 (11:54) ' Author: Peter Barney Code: QB, QBasic, PDS ' Origin: QBTIPS_M.DOC Packet: GRAPHICS.ABC '=========================================================================== '>Is there a way to run a CGA card in 16-color mode? 4-colors is kinda tiring! '>and does the code work with qb 4.00? If you've got some, send some. Thanx. ' 'The following messages are some code that I was working on a couple 'years ago when I had a cga monitor. Included are a 16-color mode and a '136-color mode. ' 'This should get you started in the right direction. DECLARE SUB Moire () DECLARE SUB Demo () DECLARE SUB GPrint (A$, x%, y%, Colr%, Size%) DECLARE SUB Mode (M%, BG%) DECLARE SUB PCircle (x%, y%, r%, c%) DECLARE FUNCTION PixColr% (x%, y%) DECLARE SUB PixSet (x%, y%, Colr%) DECLARE SUB SaveScreen (f$) DECLARE FUNCTION Sequence% (PickCol%) DECLARE SUB Setup () DECLARE FUNCTION Spectral% (PickCol%) DECLARE SUB TextDemo () DIM SHARED ModeNum SCREEN 0 '=================== Main Code =================== Begin: Setup ' this creates the screen modes (do this only once) Mode 136, 0 ' or Mode 136 , Color ' This is where you would add your code. Demo TextDemo Done: SOUND 1160, 2 SLEEP WHILE INKEY$ = "": WEND SCREEN 0, 0 END '================= End Main Code ================= ' ' 'initial data for 6845 chip (80 x 100 pixels) ' DATA 113: 'register 0 horizontal total DATA 80: 'register 1 horizontal displayed DATA 90: 'register 2 horizontal sync position DATA 10: 'register 3 horizontal sync width DATA 127: 'register 4 vertical total DATA 6: 'register 5 vertical adjust DATA 100: 'register 6 vertical displayed DATA 112: 'register 7 vertical sync position DATA 2: 'register 8 interlace mode (non-interlaced) DATA 1: 'register 9 maximum scan line address DATA 32: 'register 10 cursor start (32 makes cursor ' invisible) DATA 0: 'register 11 cursor end DEFINT A-Z SUB Demo 'draw screen (136 color demo) ' You MUST use this command to set up the screen properly. ' (note that the number may be changed, however) Mode 136, 0 ' draw Spectral circle FOR r = 0 TO 19 PCircle 60, 60, r, Spectral(r) NEXT 'this one shows how to blend the two colors FOR x = 0 TO 31 FOR y = 0 TO 63 c1 = Sequence(x \ 2 MOD 16) c2 = Sequence(y \ 4 MOD 16) Colr = c1 * 16 + c2 ' this blends color 1 with color 2 PixSet x, y, Colr NEXT NEXT ' this draws the rainbow square FOR y = 0 TO 19 FOR x = 0 TO 19 PixSet 40 + x + (19 - y), x + y, Spectral(x) PixSet 40 + x + (19 - y), x + y + 1, Spectral(x) NEXT x NEXT y SaveScreen "Demo.scn" SLEEP 5 END SUB SUB GPrint (A$, x, y, Colr, Size) ' ' This Sub will print text on the graphics screen. ' ' Example ' Gprint "Hello",10,5,23,1 ' ' Will print Hello at position 10,5 in color 23. ' ' The 1 on the end specifies big or small text. ' Use a 1 for big, 0 for small. Add 2 if you want wide letters. ' ' If you make Colr < 0 then it will use the Spectral Color Set, ' starting at color # ABS(Colr) ' REDIM A(0 TO 7) FOR M = 1 TO LEN(A$) N = ASC(MID$(A$, M, 1)) DEF SEG = &HFFA6 FOR l = 0 TO 7: B = (N * 8) + l + 14: A(l) = PEEK(B): NEXT DEF SEG = &HB800 FOR r = 0 TO 7 FOR J = 7 TO 1 STEP -1 IF (A(r) AND 2 ^ J) <> 0 THEN IF Colr < 0 THEN Co = Spectral(r - Colr) ELSE Co = Colr SELECT CASE Size CASE 0 PixSet x + (7 - J) + ((M - 1) * 8), y + r, Co CASE 1 PixSet x + (7 - J) + ((M - 1) * 8), y + r * 2, Co PixSet x + (7 - J) + ((M - 1) * 8), y + r * 2 + 1, Co CASE 2 PixSet x + (7 - J) + ((M - 1) * 8) * 2, y + r, Co PixSet x + (7 - J) + ((M - 1) * 8) * 2 + 1, y + r, Co CASE 3 PixSet x + (7 - J) + ((M - 1) * 8) * 2, y + r * 2, Co PixSet x + (7 - J) + ((M - 1) * 8) * 2, y + r * 2 + 1, Co PixSet x + (7 - J) + ((M - 1) * 8) * 2 + 1, y + r * 2, Co PixSet x + (7 - J) + ((M - 1) * 8) * 2 + 1, y + r * 2 + 1, Co END SELECT END IF NEXT NEXT NEXT END SUB SUB LoadScreen (f$) BLOAD f$, 0 END SUB SUB Mode (M, BG) IF M <> 136 AND M <> 16 THEN ERROR 5 'illegal function call ' 'clear screen: Character = &HB1, Attributes=0 ' ' this part is necessary to run before any pixels are drawn, because it ' layers a specific bit pattern on the screen that produces the colors. ' ' BG is the background color. ' for example, if you want a dark blue background, do ClearScreen 1 DEF SEG = &HB800 IF M = 136 THEN ch = &HB1 ELSE ch = &HDE FOR CHAR = 0 TO 15998 STEP 2: POKE CHAR, ch: POKE CHAR + 1, BG: NEXT ModeNum = M END SUB SUB Moire IF ModeNum = 136 THEN XM = 40: tc = 255 IF ModeNum = 16 THEN XM = 80: tc = 15 IF XM = 0 THEN STOP YM = 50 FOR y = -YM TO YM: Y2 = y * y FOR x = -XM TO XM r = INT((1E+07 * (Y2 + x * x)) ^ .255) IF r MOD 2 THEN PixSet x + XM, y + YM, 1 '(r / tc) AND ELSE PixSet x + XM, y + YM, ((r / 15) AND tc) + 1 END IF NEXT x NEXT y END SUB SUB Outline (x1, y1, x2, Y2, Colr, Colr2) FOR x = x1 TO x2 FOR y = y1 TO Y2 IF PixColr(x, y) = 0 THEN IF PixColr(x + 1, y + 1) = Colr2 THEN PixSet x, y, Colr: GOTO Skip IF PixColr(x + 1, y + 0) = Colr2 THEN PixSet x, y, Colr: GOTO Skip IF PixColr(x + 1, y - 1) = Colr2 THEN PixSet x, y, Colr: GOTO Skip IF PixColr(x - 0, y - 1) = Colr2 THEN PixSet x, y, Colr: GOTO Skip IF PixColr(x - 1, y - 1) = Colr2 THEN PixSet x, y, Colr: GOTO Skip IF PixColr(x - 1, y - 0) = Colr2 THEN PixSet x, y, Colr: GOTO Skip IF PixColr(x - 1, y + 1) = Colr2 THEN PixSet x, y, Colr: GOTO Skip IF PixColr(x + 0, y + 1) = Colr2 THEN PixSet x, y, Colr Skip: END IF NEXT NEXT END SUB SUB PBox (x1, y1, x2, Y2, Colr, Style) IF x1 > x2 THEN SWAP x1, x2 IF y1 > Y2 THEN SWAP y1, Y2 IF Style = 0 THEN FOR x = x1 TO x2: PixSet x, y1, Colr: NEXT FOR y = y1 TO Y2: PixSet x1, y, Colr: NEXT FOR x = x1 TO x2: PixSet x, Y2, Colr: NEXT FOR y = y1 TO Y2: PixSet x2, y, Colr: NEXT ELSE FOR x = x1 TO x2: FOR y = y1 TO Y2 PixSet x, y, Colr NEXT y, x END IF END SUB SUB PCircle (x, y, r, c) ' ' Draws a circle at coordinates x,y with radius r and color c ' ' FOR xv = 0 TO r yv = SQR(r ^ 2 - xv ^ 2) PixSet x + xv, y + yv, c PixSet x - xv, y - yv, c PixSet x + xv, y - yv, c PixSet x - xv, y + yv, c NEXT FOR yv = 0 TO r xv = SQR(r ^ 2 - yv ^ 2) PixSet x + xv, y + yv, c PixSet x - xv, y - yv, c PixSet x + xv, y - yv, c PixSet x - xv, y + yv, c NEXT END SUB SUB Pget (x1, y1, x2, Y2, v()) IF x1 > x2 THEN SWAP x1, x2: SWAP y1, Y2 'REDIM v((x2 - x1) * (y2 - y1) + 4) v(1) = x2 - x1: v(2) = Y2 - y1: P = 3 FOR y = y1 TO Y2 FOR x = x1 TO x2 v(P) = PixColr(x, y) P = P + 1 NEXT NEXT END SUB FUNCTION PixColr (x, y) ' ' Returns the color of the pixel at the specified coordinates ' ' To find the two colors that were blended to create the color, use ' c1 = PixColr (x,y) \ 16 ' c2 = PixColr (x,y) and 15 ' IF ModeNum = 136 THEN PixColr = PEEK(((2 * x + (y * 160)) AND &HFFFE) + 1) ELSE PIXELADDR = ((x + (y * 160)) AND &HFFFE) + 1 NIBBLE = (x + (y * 160)) MOD 2 IF NIBBLE = 0 THEN PixColr = (PEEK(PIXELADDR) AND &HF0) \ 16 IF NIBBLE = 1 THEN PixColr = PEEK(PIXELADDR) AND &HF END IF END FUNCTION SUB PixSet (x, y, Colr) ' ' Plots a point at x,y in Colr color. ' ' Colr is calculated by: color1 * 16 + color2 ' this will give you a blending of the two colors ' IF ModeNum = 136 THEN POKE ((2 * x + (y * 160)) AND &HFFFE) + 1, Colr ELSE PIXELADDR = ((x + (y * 160)) AND &HFFFE) + 1 NIBBLE = (x + (y * 160)) MOD 2 IF NIBBLE = 0 THEN POKE PIXELADDR, (PEEK(PIXELADDR) AND &HF) + Colr * &H10 IF NIBBLE = 1 THEN POKE PIXELADDR, (PEEK(PIXELADDR) AND &HF0) + Colr END IF END SUB SUB Pline (mx1, my1, mx2, my2, MColr) ' ' Not tested, may not work... ' x1 = mx1: y1 = my1: x2 = mx2: Y2 = my2: Colr = MColr IF ABS(x2 - x1) > ABS(Y2 - y1) THEN 'x is major IF x1 > x2 THEN SWAP x1, x2: SWAP y1, Y2 IF x2 - x1 = 0 THEN ys! = 0 ELSE ys! = (Y2 - y1) / (x2 - x1) FOR l = 0 TO (x2 - x1) PixSet x1 + l, y1 + M!, Colr: M! = M! + ys! NEXT ELSE 'y is major IF y1 > Y2 THEN SWAP y1, Y2: SWAP x1, x2 IF Y2 - y1 = 0 THEN xs! = 0 ELSE xs! = (x2 - x1) / (Y2 - y1) FOR l = 0 TO (Y2 - y1) PixSet x1 + M!, y1 + l, Colr: M! = M! + xs! NEXT END IF END SUB SUB Pput (x1, y1, v(), M) IF M = 1 THEN M = 0 ELSE M = 256 x2 = x1 + v(1): Y2 = y1 + v(2): P = 3 FOR y = y1 TO Y2 FOR x = x1 TO x2 IF v(P) <> M THEN PixSet x, y, v(P) P = P + 1 NEXT NEXT END SUB SUB SaveScreen (f$) BSAVE f$, 0, &H3F1E END SUB FUNCTION Sequence (PickCol) ' ' This was designed for the 136-color mode ' ' places colors in Sequence order. Used by this program to make a nifty ' color arrangement, not very usable in your programs. ' SELECT CASE PickCol + 1 CASE 1: Colr = 0 CASE 2: Colr = 8 CASE 3: Colr = 1 CASE 4: Colr = 9 CASE 5: Colr = 3 CASE 6: Colr = 11 CASE 7: Colr = 2 CASE 8: Colr = 10 CASE 9: Colr = 6 CASE 10: Colr = 14 CASE 11: Colr = 4 CASE 12: Colr = 12 CASE 13: Colr = 5 CASE 14: Colr = 13 CASE 15: Colr = 7 CASE 16: Colr = 15 CASE ELSE END SELECT Sequence = Colr END FUNCTION SUB Setup 'Color/Graphics Adapter Definitions MODEREG = &H3D8: COLORREG = &H3D9 'control registers MODESAVE = &H465: COLORSAVE = &H466 'BIOS saves the regs here CRTREG = &H3D4: CRTDATA = &H3D5 '6845 CRT controller regs 'set up Color/Graphics Adapter for 160- by 100-block graphics DEF SEG = 0: SMode = 0 POKE MODESAVE, SMode: OUT MODEREG, SMode POKE COLORSAVE, 0: OUT COLORREG, 0 'Load new parameters into 6845 CRT controller RESTORE FOR REGISTER = 0 TO 11 READ REGDATA OUT CRTREG, REGISTER: OUT CRTDATA, REGDATA NEXT 'set mode for 80 column color enable HIRES = 1: GRAPH = 2: BW = 4 'Mode register bits VIDEO = 8: G640 = 16: BLINK = 32 'Mode register bits SMode = HIRES + VIDEO POKE MODESAVE, SMode: OUT MODEREG, SMode DEF SEG = &HB800 END SUB FUNCTION Spectral (PickCol) ' 'converts ordered color numbers to a Spectrum --19 of 25 used ' ' This will give you the number of the color on the spectrum ' Example: ' x=Spectral(10) ' will give you the 10th color of the Spectrum ' right now, I have only a 19-color spectrum set up ' so the values used should be 0-19. ' SELECT CASE PickCol CASE 1: Colr = 16 CASE 2: Colr = 17 CASE 3: Colr = 145 CASE 4: Colr = 18 CASE 5: Colr = 2 CASE 6: Colr = 160 CASE 7: Colr = 162 CASE 8: Colr = 174 CASE 9: Colr = 238 CASE 10: Colr = 230 CASE 11: Colr = 236 CASE 12: Colr = 228 CASE 13: Colr = 102 CASE 14: Colr = 108 CASE 15: Colr = 204 CASE 16: Colr = 68 CASE 17: Colr = 64 CASE 18: Colr = 65 CASE 19: Colr = 81 CASE ELSE END SELECT Spectral = Colr IF ModeNum = 16 THEN Spectral = Colr AND 15 END FUNCTION SUB TextDemo Mode 136, 0 FOR y = 0 TO 15: FOR x = 0 TO 44: PixSet x, y, 255: NEXT x, y FOR y = 0 TO 15: FOR x = 45 TO 77: PixSet x, y, Spectral(y + 1): NEXT x, y FOR y = 0 TO 15: PixSet x, y, 255: PixSet x + 1, y, 255: NEXT y GPrint "Hello", 1, 1, 152, 1: GPrint "Hello", 2, 1, 1, 1 FOR y = 17 TO 35: FOR x = 0 TO 79: PixSet x, y, 153: NEXT x, y GPrint "Isn't this", 0, 19, 8, 0: GPrint "Isn't this", 1, 19, 15, 0 GPrint "cool?", 21, 27, 8, 0: GPrint "cool?", 23, 27, 15, 0: GPrint "cool?", 22, 27, 7, 0 FOR y = 37 TO 101: FOR x = 0 TO 79: PixSet x, y, 254 - (y - 37): NEXT x, y GPrint "Add life", 9, 39, -1, 0 GPrint "to your", 12, 47, -6, 0 GPrint "old CGA!", 9, 57, -13, 0 GPrint "CGA", 41, 58, -14, 0 GPrint "Nothing is", 1, 67, 0, 0 FOR J = 1 TO 10: A$ = MID$("IMPOSSIBLE", J, 1) GPrint A$, (J - 1) * 8, 77, J - 11, 1: NEXT FOR x = 1 TO 78: PixSet x, 93, 0: NEXT SaveScreen "TextDemo.scn" END SUB