'===========================================================================
' Subject: GORAU SHADED POLYGONS             Date: 09-01-96 (14:51)       
' Author:  Luke Molnar                       Code: QB, QBasic, PDS        
' Origin:  Blood225@aol.com                Packet: GRAPHICS.ABC
'===========================================================================

' Gorau Shaded Polygons.  Written by Luke Molnar.  A Molnar \ Kucalaba
' Productions program.  Tons of concept and execution help provided by
' David Eichorn.  If you are one of those people that need really obvious
' things pointed out, this is REALLY SLOW!  I don't think many people in
' their right mind would try to write a Gorau routine in QBasic and demand
' that it be fast enough for animation, but this is pretty nice looking
' if I do say so myself. :-)


' Another QBasic graphics "demo" that appeared first at :

' WWW : http://members.aol.com/mkwebsite/index.html
' FTP : ftp://users.aol.com/blood225/



DECLARE SUB GorauFill (Points() AS ANY)
DECLARE SUB Delay (Seconds!)
DECLARE SUB ChangeColors ()
DECLARE FUNCTION ValidPolPoints! ()


'$DYNAMIC
RANDOMIZE TIMER

CLS
SCREEN 13


TYPE GorType
 Y1 AS INTEGER
 Y2 AS INTEGER
 C1 AS INTEGER
 C2 AS INTEGER
END TYPE

TYPE RoutineType
 X AS INTEGER
 Y AS INTEGER
 C AS INTEGER
END TYPE



DIM SHARED PolPoints(0 TO 3) AS RoutineType


COLOR 230

DO
 
     ThisShouldBeASub% = ValidPolPoints ' Generate decent polygon points

     ChangeColors                       ' Randomly assign a color scheme

     GorauFill PolPoints()              ' Fill the 4 point polygon
 
     Delay 1                            ' Give user time to admire the beauty                         

  User$ = INKEY$                        ' Store any keypresses  

  CLS                                   ' Clear the screen

LOOP UNTIL User$ <> ""                  ' Keep going until they press a key

CLS
SCREEN 0
WIDTH 80
SYSTEM

REM $STATIC
SUB ChangeColors

' Changes the palette to one of 6 possible color variations

DifColors% = INT(RND * 6) + 1

FOR X% = 1 TO 230

 OUT &H3C8, X%

  SELECT CASE DifColors%
   CASE 1: OUT &H3C9, EasyVal!: OUT &H3C9, 0: OUT &H3C9, 0
   CASE 2: OUT &H3C9, 0: OUT &H3C9, EasyVal!: OUT &H3C9, 0
   CASE 3: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, EasyVal!
   CASE 4: OUT &H3C9, EasyVal!: OUT &H3C9, EasyVal!: OUT &H3C9, EasyVal!
   CASE 5: OUT &H3C9, EasyVal!: OUT &H3C9, EasyVal!: OUT &H3C9, 0
   CASE 6: OUT &H3C9, EasyVal!: OUT &H3C9, 0: OUT &H3C9, EasyVal!
  END SELECT

 EasyVal! = EasyVal! + .273913

NEXT

END SUB

SUB Delay (Seconds!)
Future! = TIMER + Seconds!
DO
LOOP UNTIL TIMER >= Future! OR TIMER - (TIMER - Seconds!) < 0
END SUB

SUB GorauFill (Points() AS RoutineType)

DIM Scan(0 TO 320) AS GorType

XMax% = -32767
Xmin% = 32767

FOR X% = 0 TO 3
  IF XMax% < Points(X%).X THEN XMax% = Points(X%).X
  IF Xmin% > Points(X%).X THEN Xmin% = Points(X%).X
  PSET (Points(X%).X, Points(X%).Y), 230
NEXT


 IF Xmin% < 0 THEN Xmin% = 0
 IF XMax% > 320 THEN XMax% = 320
 IF Xmin% > 320 THEN EXIT SUB
 IF XMax% < 0 THEN EXIT SUB

FOR X% = Xmin% TO XMax%
  Scan(X%).Y1 = -32767
NEXT



FOR X% = 0 TO 3

  Val1% = X%
  Val2% = (X% + 1) MOD 4

    IF Points(Val1%).X > Points(Val2%).X THEN
      SWAP Val1%, Val2%
    END IF
 
  Y1% = Points(Val1%).Y
  x1% = Points(Val1%).X
  Col1% = Points(Val1%).C

  Y2% = Points(Val2%).Y
  x2% = Points(Val2%).X
  Col2% = Points(Val2%).C

  YDelta% = Y2% - Y1%
 
  XDelta% = x2% - x1%
  CDelta% = Col2% - Col1%
 
  IF XDelta% <> 0 THEN
   YSlope! = YDelta% / XDelta%
   CSlope! = CDelta% / XDelta%
  ELSE
   YSlope% = 0
   CSlope% = 0
  END IF

  YVal! = Y1%
  CVal! = Col1%
 
      FOR I% = x1% TO x2%
       
        IF Scan(I%).Y1 = -32767 THEN
          Scan(I%).Y1 = YVal!
          Scan(I%).C1 = CVal!
        ELSE
          Scan(I%).Y2 = YVal!
          Scan(I%).C2 = CVal!
        END IF

        YVal! = YVal! + YSlope!
        CVal! = CVal! + CSlope!
     
      NEXT

NEXT



FOR X% = Xmin% TO XMax%

  IF Scan(X%).Y1 > Scan(X%).Y2 THEN
    Y2% = Scan(X%).Y1
    Y1% = Scan(X%).Y2
    Col2% = Scan(X%).C1
    Col1% = Scan(X%).C2
  ELSE
    Y2% = Scan(X%).Y2
    Y1% = Scan(X%).Y1
    Col2% = Scan(X%).C2
    Col1% = Scan(X%).C1
  END IF

  YDelta% = Y2% - Y1%
 
  IF YDelta% = 0 THEN YDelta% = 1

  CDelta% = Col2% - Col1%
  CSlope! = CDelta% / YDelta%
  CVal! = Col1%

    FOR I% = Scan(X%).Y1 TO Scan(X%).Y2
      PSET (X%, I%), CVal!
      CVal! = CVal! + CSlope!
    NEXT

NEXT



END SUB

FUNCTION ValidPolPoints

' There are certain occurences with this routine in which the polygon will
' not be correctly filled in.  This routine prevents those polygons from
' happening.

FOR I% = 0 TO 3
 
  SELECT CASE I%
    CASE 0:
           PolPoints(0).X = INT(RND * 60) + 1
           PolPoints(0).Y = INT(RND * 60) + 1
    CASE 1:
           PolPoints(1).X = INT(RND * 160) + 160
           PolPoints(1).Y = INT(RND * 100) + 2
'           IF PolPoints(1).Y < PolPoints(0).Y THEN PolPoints(1).Y = PolPoints(0).Y + INT(RND * (100 - PolPoints(0).Y))
    CASE 2:
           PolPoints(2).X = INT(RND * 160) + 160
'           IF PolPoints(2).X < PolPoints(1).X THEN PolPoints(2).X = PolPoints(1).X + 1
           PolPoints(2).Y = INT(RND * 50) + 150
    CASE 3:
           PolPoints(3).X = INT(RND * 160) + 1
           IF PolPoints(3).X < PolPoints(0).X THEN PolPoints(3).X = PolPoints(0).X + INT(RND * (160 - PolPoints(0).X))
           PolPoints(3).Y = INT(RND * 100) + 100
'           IF PolPoints(3).Y < PolPoints(2).Y THEN PolPoints(3).Y = PolPoints(2).Y + INT(RND * (100 - PolPoints(2).Y))
  END SELECT

 PolPoints(I%).C = -1

NEXT

 
' Make one corner black and one corner the brightest color; the other 2 random
  
   DO UNTIL BlackOne% <> BrightOne%
     BlackOne% = INT(RND * 3)
     BrightOne% = INT(RND * 3)
   LOOP

  PolPoints(BlackOne%).C = 0
  PolPoints(BrightOne%).C = 230

  FOR I% = 0 TO 3
   IF PolPoints(I%).C = -1 THEN PolPoints(I%).C = INT(RND * 230) + 1
  NEXT

END FUNCTION