TIP: Click on subject to list as thread! ANSI
echo: power_bas
to: ALL
from: KURT KUZBA
date: 1996-04-20 15:23:00
subject: R: Mode 13h circles

I recently ported a Bresenham routine for circles to Quick Basic, and
thought I would send it here as well, along with a simple program
using it to create a multi-colored display.
'_|_|_|   FLOBALLS.BAS
'_|_|_|   A graphics display program based on a FIDO ECHO message
'_|_|_|   From: Mike Castelli   ...   Date: 04-05-96 10:48
'_|_|_|   Subject: Circle Burn  ...   Echo: QuickBasic
'_|_|_|   No guarantees or warrantees are given or implied.
'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (4/20/96)
TYPE BallsColorDef
   R AS INTEGER: G AS INTEGER: B AS INTEGER: END TYPE
TYPE GreatBallsOfFire
   X AS INTEGER: XD AS INTEGER: Y AS INTEGER: YD AS INTEGER
   H AS INTEGER: C AS INTEGER: END TYPE
DIM cr(1 TO 5) AS GreatBallsOfFire: SHARED cr()
DIM rgb(1 TO 5, 16) AS BallsColorDef: SHARED rgb()
FOR t% = 0 TO 8
   C% = t% * 5 + 22: B% = (t% + 1) * 2
   rgb(1, t%).R = C%: rgb(1, t%).G = B%: rgb(1, t%).B = t%
   rgb(2, t%).R = t%: rgb(2, t%).G = C%: rgb(2, t%).B = B%
   rgb(3, t%).R = B%: rgb(3, t%).G = t%: rgb(3, t%).B = C%
   rgb(4, t%).R = C%: rgb(4, t%).G = 0: rgb(4, t%).B = C%
   rgb(5, t%).R = C%: rgb(5, t%).G = C%: rgb(5, t%).B = 0: NEXT
FOR t% = 1 TO 7: FOR C% = 1 TO 5
   rgb(C%, 16 - t%) = rgb(C%, t%): NEXT: NEXT
!   mov ah, &H00
!   mov al, &H13
!   int &H10
RANDOMIZE (TIMER * 100)
PalPocket 1
FOR t% = 1 TO 5: cr(t%).X = RND * 320: cr(t%).Y = RND * 200
   cr(t%).XD = (RND * 2 + 1): cr(t%).YD = (RND * 2 + 1)
   cr(t%).H = t% * 2: NEXT
WHILE INKEY$ = ""
   CircDraw
   FOR t% = 1 TO 5
      IF cr(t%).X < 10 THEN cr(t%).XD = RND * 2 + 1
      IF cr(t%).Y < 10 THEN cr(t%).YD = RND * 2 + 1
      IF cr(t%).X > 309 THEN cr(t%).XD = -(RND * 2 + 1)
      IF cr(t%).Y > 189 THEN cr(t%).YD = -(RND * 2 + 1)
      cr(t%).X = cr(t%).X + cr(t%).XD
      cr(t%).Y = cr(t%).Y + cr(t%).YD: NEXT
WEND: WHILE INKEY$ = "": WEND: PalPocket 0
!   mov ah, &H00
!   mov al, &H03
!   int &H10
SUB CircDraw
   FOR C% = 1 TO 5: cr(C%).H = (cr(C%).H + 1) AND 15
      cr(C%).C = (cr(C%).C + 14) AND 15: HU% = C% * 16 - 15
      X% = cr(C%).X: Y% = cr(C%).Y: H% = cr(C%).H
      FOR l% = 0 TO 9: HUE% = ((H% + l%) AND 15) + HU%
         BCircle X%, Y%, l% + 1, HUE%: NEXT
      FOR t% = 1 TO 16
         OUT &H3C8, t% + (C% - 1) * 16: H% = (cr(C%).C + t%) AND 15
         OUT &H3C9, rgb(C%, H%).R: OUT &H3C9, rgb(C%, H%).G
         OUT &H3C9, rgb(C%, H%).B: NEXT: NEXT
END SUB
SUB PalPocket (save%) STATIC
   DIM pal(384) AS INTEGER
   DEF SEG = VARSEG(pal(0)): O& = VARPTR(pal(0))
   IF save%  0 THEN
      FOR t% = 0 TO 255: OUT &H3C7, t%:
         POKE O& + t% * 3 + 0, INP(&H3C9)
         POKE O& + t% * 3 + 1, INP(&H3C9)
         POKE O& + t% * 3 + 2, INP(&H3C9): NEXT
   ELSE::FOR t% = 0 TO 255: OUT &H3C8, t%
         OUT &H3C9, PEEK(O& + t% * 3 + 0)
         OUT &H3C9, PEEK(O& + t% * 3 + 1)
         OUT &H3C9, PEEK(O& + t% * 3 + 2): NEXT
   END IF
END SUB
SUB BCircle (xc%, yc%, r%, C%)
'_|_|_|   Bresenham Circle Drawing Algorithm
'_|_|_|   Adapted from BRESNHAM.C in Bob Stout's SNIPPETS.
   WIDE% = 320: HIGH% = 200
   x% = 0: d% = 2 * (1 - r%): W% = 2 * WIDE% \ HIGH%
   WHILE r% >= 0
      Pix xc% + x%, yc% + r%, C%: Pix xc% + x%, yc% - r%, C%
      Pix xc% - x%, yc% + r%, C%: Pix xc% - x%, yc% - r%, C%
      IF (d% + r%) > 0 THEN r% = r% - 1: d% = d% - W% * r% - 1
      IF x% > d% THEN x% = x% + 1: d% = d% + 2 * x% + 1
   WEND
END SUB
SUB Pix (x%, y%, c%)
   DEF SEG = &HA000: IF (y% > 199) OR (x% > 319) THEN EXIT SUB
   IF (y% >= 0) AND (x% >= 0) THEN POKE y% * 320 + x%, c%
END SUB
'_|_|_|   end   FLOBALLS.BAS

---
> ] Once you know me better, you'll like me even less...........

---------------

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.