Important Notice
The pages on this site contain documentation for very old MS-DOS software,
purely for historical purposes.
If you're looking for up-to-date documentation, particularly for programming,
you should not rely on the information found here, as it will be woefully
out of date.
SINE.FOR
◄Up► ◄Contents► ◄Index► ◄Back►
────────────────────────────────────────────────────────────────────────────
CC SINE.FOR - Illustrates basic graphics commands.
INCLUDE 'FGRAPH.FI'
CALL graphicsmode()
CALL drawlines()
CALL sinewave()
CALL drawshapes()
CALL endprogram()
END
C Definitions of subroutines go here . . .
SUBROUTINE graphicsmode()
INCLUDE 'FGRAPH.FD'
INTEGER*2 dummy, maxx, maxy
RECORD /videoconfig/ myscreen
COMMON maxx, maxy
C
C Find graphics mode.
C
CALL getvideoconfig( myscreen )
SELECT CASE( myscreen.adapter )
CASE( $CGA )
dummy = setvideomode( $HRESBW )
CASE( $OCGA )
dummy = setvideomode( $ORESCOLOR )
CASE( $EGA, $OEGA )
IF( myscreen.monitor .EQ. $MONO ) THEN
dummy = setvideomode( $ERESNOCOLOR )
ELSE
dummy = setvideomode( $ERESCOLOR )
END IF
CASE( $VGA, $OVGA, $MCGA )
dummy = setvideomode( $VRES2COLOR )
CASE( $HGC )
dummy = setvideomode ( $HERCMONO )
CASE DEFAULT
dummy = 0
END SELECT
IF( dummy .EQ. 0 ) STOP 'Error: cannot set graphics mode'
C
C Determine the minimum and maximum dimensions.
C
CALL getvideoconfig( myscreen )
maxx = myscreen.numxpixels - 1
maxy = myscreen.numypixels - 1
END
CC NEWX - This function finds new x coordinates.
INTEGER*2 FUNCTION newx( xcoord )
INTEGER*2 xcoord, maxx, maxy
REAL*4 tempx
COMMON maxx, maxy
tempx = maxx / 1000.0
tempx = xcoord * tempx + 0.5
newx = tempx
END
CC NEWY - This function finds new y coordinates.
INTEGER*2 FUNCTION newy( ycoord )
INTEGER*2 ycoord, maxx, maxy
REAL*4 tempy
COMMON maxx, maxy
tempy = maxy / 1000.0
tempy = ycoord * tempy + 0.5
newy = tempy
END
CC DRAWLINES - This subroutine draws a box and several lines.
SUBROUTINE drawlines()
INCLUDE 'FGRAPH.FD'
EXTERNAL newx,newy
INTEGER*2 dummy, newx, newy, maxx, maxy
RECORD /xycoord/ xy
COMMON maxx, maxy
C
C Draw the box.
C
dummy = rectangle( $GBORDER, 0, 0, maxx, maxy )
CALL setvieworg( 0, newy( INT2( 500 ) ), xy )
C
C Draw the lines.
C
CALL moveto( 0, 0, xy )
dummy = lineto( newx( INT2( 1000 ) ), 0 )
CALL setlinestyle( #AA3C )
CALL moveto( 0, newy( INT2( -250 ) ), xy )
dummy = lineto( newx( INT2( 1000 ) ), newy( INT2( -250 ) ) )
CALL setlinestyle( #8888 )
CALL moveto( 0, newy( INT2( 250 ) ), xy )
dummy = lineto( newx( INT2( 1000 ) ), newy( INT2( 250 ) ) )
END
CC SINEWAVE - This subroutine calculates and plots a sine wave.
SUBROUTINE sinewave()
INCLUDE 'FGRAPH.FD'
INTEGER*2 dummy, newx, newy, locx, locy, i
DOUBLE PRECISION rad, PI
EXTERNAL newx, newy
PARAMETER ( PI = 3.14159 )
C
C Calculate each position and display it on the screen.
C
DO i = 0, 999, 3
rad = -SIN( PI * i / 250.0 )
locx = newx( i )
locy = newy( INT2( rad * 250.0 ) )
dummy = setpixel( locx, locy )
END DO
END
CC DRAWSHAPES - This subroutine draws two boxes and two ellipses.
SUBROUTINE drawshapes()
INCLUDE 'FGRAPH.FD'
EXTERNAL newx, newy
INTEGER*2 dummy, newx, newy
C
C Create a masking (fill) pattern.
C
INTEGER*1 diagmask(8), linemask(8)
DATA diagmask / #93, #C9, #64, #B2, #59, #2C, #96, #4B /
DATA linemask / #FF, #00, #7F, #FE, #00, #00, #00, #CC /
C
C Draw the rectangles.
C
CALL setlinestyle( #FFFF )
CALL setfillmask( diagmask )
dummy = rectangle( $GBORDER,
+ newx( INT2( 50 ) ), newy( INT2( -325 ) ),
+ newx( INT2( 200 ) ), newy( INT2( -425 ) ) )
dummy = rectangle( $GFILLINTERIOR,
+ newx( INT2( 550 ) ), newy( INT2( -325 ) ),
+ newx( INT2( 700 ) ), newy( INT2( -425 ) ) )
C
C Draw the ellipses.
C
CALL setfillmask( linemask )
dummy = ellipse( $GBORDER,
+ newx( INT2( 50 ) ), newy( INT2( 325 ) ),
+ newx( INT2( 200 ) ), newy( INT2( 425 ) ) )
dummy = ellipse( $GFILLINTERIOR,
+ newx( INT2( 550 ) ), newy( INT2( 325 ) ),
+ newx( INT2( 700 ) ), newy( INT2( 425 ) ) )
END
CC ENDPROGRAM - This subroutine waits for the ENTER key to be
CC pressed, then resets the screen to normal before returning.
SUBROUTINE endprogram()
INCLUDE 'FGRAPH.FD'
INTEGER*2 dummy
READ (*,*) ! Wait for ENTER key
dummy = setvideomode( $DEFAULTMODE )
END