this is a little grafx program i wrote last week.. have fun =)

eidolon

--- begin xform50.bas
'X F O R M  5 . 0
'(aka grafx2-5)
'
'
'this is a mod of a mod of my original grafx transformation programs that
'animates a matrix figure through constantly multiplying it by random values,
'with a definable number of trailers (see the variable description for
''figures' for a description).
'
'new in this version:
'   automatic randomization of all changeable variables
'   just hit <space> or <cr> for a new figure
'   save & recall data sets to/from [easy to edit] ascii files
'   new palette change routine, more random
'   fade in/out if fadr! > 0
'   command line reading
'   multiple parts of this doc are new
'
'variable descriptions:
' t!() is the transformation matrix
' a!() is the original matrix
' b!() holds the transformed a!()
'
' to enter immediate values for the following variables, go to the beginning
' of the 'create' sub and read the comment there.
'
' choppy is a single precision number that is the spacing between figures,
'   but turning the value UP will make the display *less* choppy (and that
'   doesn't bother me so i'm not gonna change it :)). effective values
'   are <= 50, i suggest <= 15.
' delay is a single precision number that slows the program down delay
'   seconds in each iteration. you *will* need to change how it is created in
'   the create sub -- i'm running on a 386/40 (in 1998! =D), so it runs
'   slower on my machine than it will on yours. just decrease the number
'   delay! is divided by (on line 10 of sub 'create').
' clr is an integer that is the color to display in if you don't want a
'   palette fade. move the cursor to the word 'color' and hit f1 to see all
'   possible colors (use the values for screen mode 0).
' fadr is a single precision number that is the speed of the palette change.
'   i suggest using values <= .25. set to 0 to use CLR for the color (you
'   won't get a fade to black, though, since i don't know the default rgb
'   values for each color. sorry.).
' numpoints is an integer >= 0 that is the number of vertices for the figure.
'   use 0 to generate a random number.
' figures, known as 'trailers' in previous versions, is an integer > 0 that
'   is the number of figures to have onscreen at once. i changed the name
'   cause if trailers = 1, there would only be 1 figure on the screen, ie
'   there wouldn't be anything trailing anything, so it was a bit of a
'   misnomer.
' FADRMODE is an integer constant that chooses the method used to fade
'   through the palette, and can be either 0 or 1. FADRMORE = 0 uses the same
'   palette routine as previous versions of xform, and FADRMODE = 1 uses the
'   new routine that seems to produce softer colors.
'
'a few notes about the filehandling: 1) any xform5 data filename you enter
'will be appended to (or created) when saving. 2) if you get a polygon you
'like, but there's too many figures (trailers), or the delay is off or
'something, save it & edit the filename you saved to; the variables are all
'labeled in the save files (by name only; use the above descriptions). 3) you
'can add comments between data sets in data files (sets are seperated by a
'blank line); just begin the line with a semicolon (;).
'run the program to see the controls in the different modes (create/save, &
'restore).
'
'you can also specify a data file to load from the command line in this
'version. to run the source of xform50 as if it were an executable file and
'load a data file at the same time, use the following to load qb:
'qb /run xform50 /cmd/l<datafile>
'where <datafile> is the name of the xform50 data file you want to load. just
'truncate everything from /cmd on if you don't want to load a data file. to
'change command$ from within the qb4.5 ide, hit <alt>, r, c.
'
'
'have fun =)
'
'written by eidolon (john roussin) & released into the public domain.
'if you release a mod of this code, please add a note here so ppl know its
'not my original code.
'mod of grafx2-4 (aka xform2); written 12/21/98.

DEFINT A-Z
DECLARE SUB create ()
DECLARE SUB recall (switch)
DECLARE SUB save ()

CONST FALSE = 0, TRUE = NOT FALSE, FADRMODE = 0
COMMON SHARED a!(), b!(), cleanup!(), choppy!, delay!, clr, fadr!, numpoints
COMMON SHARED figures, filename$
'$DYNAMIC

RANDOMIZE TIMER
ON ERROR GOTO shit    '<- funny!

IF INSTR(LCASE$(COMMAND$), "/l") THEN
    filename$ = MID$(COMMAND$, INSTR(LCASE$(COMMAND$), "/l") + 2)
    recall 0
    recmode = TRUE

  ELSEIF INSTR(LCASE$(COMMAND$), "/c") THEN
    create
    'recmode automatically equals FALSE (FALSE == 0)

  ELSE
    LOCATE , , 1
    PRINT "(r)ecall from file"
    PRINT "(c)reate random data"
    PRINT "(q)uit"
    PRINT
    PRINT " [c] > ";
    DO
      a$ = LCASE$(INKEY$)
    LOOP WHILE a$ = ""
    SELECT CASE a$
      CASE "r"
        PRINT "r"
        recall 0
        PRINT
        PRINT "controls:"
        PRINT : PRINT
        PRINT "    <space>, <cr>   -  next data set from "; filename$
        PRINT "    q, <esc>        -  end"
        PRINT : PRINT "press any key to begin..";
        WHILE INKEY$ = "": WEND
        recmode = TRUE
      CASE "q", CHR$(27)
        PRINT "q"
        END
      CASE ELSE
        PRINT "c"
        PRINT : PRINT
        PRINT "controls:"
        PRINT "    s               -  save current data set, prompting"
        PRINT "                       for filename if necessary"
        PRINT "    <space>, <cr>   -  create new random figure"
        PRINT "    q, <esc>        -  end"
        PRINT : PRINT "press any key to begin..";
        WHILE INKEY$ = "": WEND
        create
        'recmode automatically equals FALSE (FALSE == 0)
    END SELECT
END IF

DIM t!(2, 2)

SCREEN 12

'set original transformation matrix
t!(1, 1) = 1: t!(1, 2) = 0        'x
t!(2, 1) = 0: t!(2, 2) = 1        'y

'next 2 sections get a 1 or a -1 for signs
sign11 = INT(RND * 2)
sign12 = INT(RND * 2)
sign21 = INT(RND * 2)
sign22 = INT(RND * 2)

IF sign11 = 0 THEN sign11 = -1
IF sign12 = 0 THEN sign12 = -1
IF sign21 = 0 THEN sign21 = -1
IF sign22 = 0 THEN sign22 = -1

'txx! is multiplied by signxx & added to t!(x, x) in every iteration
t11! = sign11 * (RND / choppy!)
t12! = sign12 * (RND / choppy!)
t21! = sign21 * (RND / choppy!)
t22! = sign22 * (RND / choppy!)

IF fadr! > 0 THEN                      'for palette fade
    red = INT(RND * 5) + 10
    green = INT(RND * 5) + 10
    blue = INT(RND * 5) + 10
    rc = INT(RND * 2) + 1
    gc = -INT(RND * 2 + 1)
    bc = INT(RND * 2 + 1)
    f! = TIMER
END IF

DO
  IF (absending OR ending) AND TIMER > dimslow! THEN      'fade to black
      'will automatically exit first time if fadr! = 0 (red & green & blue
      'will be 0)
      IF NOT red < 8 THEN red = red - 2 ELSE re = TRUE
      IF NOT green < 8 THEN green = green - 2 ELSE ge = TRUE
      IF NOT blue < 8 THEN blue = blue - 2 ELSE be = TRUE

      IF re AND ge AND be THEN
          IF absending THEN
              CLOSE
              COLOR 7
              END
            ELSEIF ending THEN
              CLS
              'still black, makes it get visible faster
              IF fadr! > 0 THEN red = 12: green = 12: blue = 12
              re = FALSE: ge = FALSE: be = FALSE
              ending = FALSE
              IF recmode THEN recall 1 ELSE create
          END IF
      END IF

      IF fadr! > 0 THEN
          'figure out new value (formula taken from details under palette help)
          p& = INT(65536 * blue + 256 * green + red)

          PALETTE clr, p&      'set new color
          dimslow! = TIMER + .07
      END IF

    ELSEIF TIMER > f! AND fadr! > 0 THEN
      GOSUB changcolr
      f! = TIMER + fadr!

  END IF

  'display a!() in CLR
  FOR d = 1 TO numpoints - 1
    LINE (b!(1, d) + 320, 240 - b!(2, d))-(320 + b!(1, d + 1), 240 - b!(2, d + 1)), clr
  NEXT
    'connect last point to first
    LINE (b!(1, numpoints) + 320, 240 - b!(2, numpoints))-(320 + b!(1, 1), 240 - b!(2, 1)), clr

  'LOCATE 1, 1
  'PRINT USING "#.#####    #.#####"; t!(1, 1); t!(1, 2)
  'PRINT USING "#.#####    #.#####"; t!(2, 1); t!(2, 2)
  'PRINT
  'PRINT USING "#.#####    #.#####"; t11!; t12!
  'PRINT USING "#.#####    #.#####"; t21!; t22!

  t!(1, 1) = t!(1, 1) + t11!
  t!(1, 2) = t!(1, 2) + t12!
  t!(2, 1) = t!(2, 1) + t21!
  t!(2, 2) = t!(2, 2) + t22!

  'if any t!() is too big/small, ie so big that it might move the figure off
  'screen, negate signxx & get new value to add to t!(x, x)
  IF t!(1, 1) > 1.3 THEN sign11 = -1: t11! = sign11 * (RND / choppy!)
  IF t!(1, 1) < -1.3 THEN sign11 = 1: t11! = sign11 * (RND / choppy!)

  IF t!(1, 2) > 1.3 THEN sign12 = -1: t12! = sign12 * (RND / choppy!)
  IF t!(1, 2) < -1.3 THEN sign12 = 1: t12! = sign12 * (RND / choppy!)

  IF t!(2, 1) > 1.3 THEN sign21 = -1: t21! = sign21 * (RND / choppy!)
  IF t!(2, 1) < -1.3 THEN sign21 = 1: t21! = sign21 * (RND / choppy!)

  IF t!(2, 2) > 1.3 THEN sign22 = -1: t22! = sign22 * (RND / choppy!)
  IF t!(2, 2) < -1.3 THEN sign22 = 1: t22! = sign22 * (RND / choppy!)

  d! = TIMER + delay!
  IF d! > 86400 THEN d! = d! - 86400
  WHILE TIMER < d!: WEND

  a$ = INKEY$
  IF NOT a$ = "" THEN
      a$ = LCASE$(a$)
      IF recmode = FALSE THEN   'creating random data
          SELECT CASE a$
            CASE "s"            'save current data
              save
            CASE " ", CHR$(13)  'new data set
              'create will be called after fade to black is finished
              ending = TRUE
            CASE "q", CHR$(27)
              absending = TRUE
            CASE ELSE
              BEEP
          END SELECT
        ELSE                    'recalling data from file
          SELECT CASE a$
            CASE " ", CHR$(13)  'next data set
              'recall will be called after fade to black is finished
              ending = TRUE
            CASE "q", CHR$(27)
              absending = TRUE
            CASE ELSE
              BEEP
          END SELECT
      END IF
  END IF

  'rotate cleanup!() values up towards cleanup!(1)
  'this loop won't execute (wasting time) if figures = 1
  FOR d1 = 1 TO figures - 1
    FOR d2 = 1 TO numpoints
      cleanup!(d1, 1, d2) = cleanup!(d1 + 1, 1, d2)
      cleanup!(d1, 2, d2) = cleanup!(d1 + 1, 2, d2)
    NEXT
  NEXT
    'assign cleanup!(figures) (point just drawn)
    FOR d2 = 1 TO numpoints
      cleanup!(figures, 1, d2) = b!(1, d2)
      cleanup!(figures, 2, d2) = b!(2, d2)
    NEXT

  'erase a!()
  FOR d = 1 TO numpoints - 1
    LINE (cleanup!(1, 1, d) + 320, 240 - cleanup!(1, 2, d))-(320 + cleanup!(1, 1, d + 1), 240 - cleanup!(1, 2, d + 1)), 0
  NEXT
    'connect first point to last
    LINE (cleanup!(1, 1, 1) + 320, 240 - cleanup!(1, 2, 1))-(320 + cleanup!(1, 1, numpoints), 240 - cleanup!(1, 2, numpoints)), 0

  'calculate transformation
  FOR d1 = 1 TO numpoints
    b!(1, d1) = t!(1, 1) * a!(1, d1) + t!(1, 2) * a!(2, d1)
    b!(2, d1) = t!(2, 1) * a!(1, d1) + t!(2, 2) * a!(2, d1)
  NEXT
LOOP
END

changcolr:
  green = green + gc             'update color counters
  blue = blue + bc
  red = red + rc

  IF FADRMODE = 0 THEN
      IF red <= 6 THEN rc = INT(RND * 3 + 1)     'check to see if anythings too
      IF red >= 55 THEN rc = -INT(RND * 3 + 1)   'high/low

      IF blue <= 6 THEN bc = INT(RND * 2 + 1)
      IF blue >= 55 THEN bc = -INT(RND * 2 + 1)

      IF green <= 6 THEN gc = INT(RND * 2 + 1)
      IF green >= 55 THEN gc = -INT(RND * 2 + 1)

    ELSE
      IF red > 60 OR red < 3 THEN
          rc = -rc
        ELSE
          '25% chance for new red counter
          IF RND > .75 THEN rc = INT(RND * 2) + 1
      END IF

      IF green > 60 OR green < 3 THEN
          gc = -gc
        ELSE
          '25% chance for new green counter
          IF RND > .75 THEN gc = INT(RND * 2) + 1
      END IF

      IF blue > 60 OR blue < 3 THEN
          bc = -bc
        ELSE
          '25% chance for new blue counter
          IF RND > .75 THEN bc = INT(RND * 2) + 1
      END IF
  END IF

  'LOCATE 1, 1
  'PRINT red; green; blue, fadr!
  'PRINT rc; gc; bc

  p& = INT(65536 * blue + 256 * green + red)   'figure out new value (formula
                                               'taken from details under
  PALETTE clr, p&      'set new color          'palette help)

  RETURN

shit:           'errorhandler
  BEEP
  SELECT CASE ERR
    CASE 5             'illegal red/green/blue
      PRINT "shit! there was a problem changing the palette.."
      PRINT "thought i killed this bug.. <sigh>"
    CASE 6
      PRINT "overflow"
    CASE 9, 52 TO 54, 62, 64, 70 TO 72, 75   'see below for defs
      '(bfn == (b)ad (f)ile(n)ame)
      bfn = TRUE       'check for existance of filename given in recall sub
      CLOSE
      RESUME NEXT
    CASE ELSE
      PRINT "unexpected error"
      PRINT "code:"; ERR
  END SELECT
  CLOSE
  END

'error codes:
'52      Bad file name or number
'53      File NOT found
'54      Bad file mode
'strange, ERR reports 9 on 'input past end of file', but qb's help sez 62 (?)
'62      Input past end of file
'64      Bad file name
'70      Permission denied
'71      Disk NOT ready
'72      Disk-media error
'75      Path/File access error

REM $STATIC
SUB create

'comment out the next 6 lines if you want to use immediate values
choppy! = RND * 10 + 2
clr = 2
'gets a random number between .62 and .28.
'formula taken from details under RND help.
fadr! = ((.62 - .28) * RND + .28)
numpoints = INT(RND * 4) + 4
figures = INT(RND * 13) + 4
delay! = figures / 120

REDIM a!(2, numpoints), b!(2, numpoints), cleanup!(figures, 2, numpoints)

'create a!()
FOR d1 = 1 TO numpoints
  FOR d2 = 1 TO 2
    a!(d2, d1) = INT(RND * 400) - 200
  NEXT
NEXT

END SUB

SUB recall (switch)
SHARED bfn

'switch values:
'  0  -  startup routine, get filename, etc
'  1  -  get next data set

IF switch = 0 THEN
    DO
      PRINT

      IF filename$ = "" THEN
          INPUT "filename: ", filename$
          IF filename$ = "" THEN END
      END IF

      OPEN filename$ FOR INPUT AS #1

      'bfn will be set in the errorhandler if the above OPEN statement gave
      'an error, and the file will be closed..

      IF bfn = TRUE THEN
          PRINT "apparently there was a problem with that file."

        ELSE
          LINE INPUT #1, check$

          IF NOT check$ = "X F O R M  5 . 0" THEN
              PRINT "apparently "; filename$; " is not an xform5 file."
            ELSE
              EXIT DO
          END IF

      END IF

      PRINT "try again? [y] > ";
      a$ = INPUT$(1)
      PRINT a$
      IF a$ = "n" THEN END
    LOOP

END IF

'some editors add 1 or more blank lines to the ends of text files. this gets
'past any that might have been added if you've modified the current data file
'externally, as well as the blank line that seperates data sets.
DO
  IF EOF(1) THEN
      PRINT "end of file "; filename$; " reached."
      PRINT "restart from beginning? [n] ";
      'input$() refuses to display a cursor in screen mode 12, even with
      ' LOCATE , , 1
      'but owell..
      a$ = LCASE$(INPUT$(1))
      IF a$ = "y" THEN
          CLS
          CLOSE #1
          OPEN filename$ FOR INPUT AS #1
          INPUT #1, id$         'file is same, but still need to get past id$
          INPUT #1, blank$      'blank line that seperates data sets
        ELSE
          END
      END IF
  END IF

  LINE INPUT #1, t1$
LOOP WHILE RTRIM$(t1$) = "" OR LEFT$(t1$, 1) = ";"

numpoints = VAL(MID$(t1$, 12))  't1$ from the above loop will hold numpoints
REDIM a!(2, numpoints), b!(2, numpoints)

FOR d1 = 1 TO numpoints
  LINE INPUT #1, t1$
  LINE INPUT #1, t2$
  a!(1, d1) = VAL(MID$(t1$, 12))
  a!(2, d1) = VAL(MID$(t2$, 12))
NEXT

LINE INPUT #1, t1$
choppy! = VAL(MID$(t1$, 12))

LINE INPUT #1, t1$
delay! = VAL(MID$(t1$, 12))

LINE INPUT #1, t1$
clr = VAL(MID$(t1$, 12))

LINE INPUT #1, t1$
fadr! = VAL(MID$(t1$, 12))

LINE INPUT #1, t1$
figures = VAL(MID$(t1$, 12))
REDIM cleanup!(figures, 2, numpoints)

END SUB

SUB save
SHARED bfn

IF filename$ = "" THEN
    DO
      LOCATE 1, 1
      INPUT "filename: ", filename$

      IF INSTR(filename$, " ") THEN
          ERROR 52
        ELSE
          IF filename$ = "" THEN GOSUB eras: EXIT SUB
          OPEN filename$ FOR APPEND AS #1
      END IF

      IF bfn = TRUE THEN       'bfn is also set on an illegal filename
          bfn = FALSE   'reset
          PRINT "apparently "; filename$; " is not a legal filename."

        ELSE
          'if new file then print id string
          IF LOF(1) = 0 THEN PRINT #1, "X F O R M  5 . 0"
          EXIT DO
      END IF

      PRINT
      PRINT "try again? [Y/n] > ";
      a$ = INPUT$(1)
      GOSUB eras
      IF a$ = "n" THEN EXIT SUB
    LOOP

  ELSE
    OPEN filename$ FOR APPEND AS #1

END IF

GOSUB eras

PRINT #1, ""    'blank line to seperate data sets
PRINT #1, "numpoints ="; numpoints
FOR d1 = 1 TO numpoints
  s1$ = "a!(" + LTRIM$(STR$(1)) + "," + STR$(d1) + ")  ="
  s2$ = "a!(" + LTRIM$(STR$(2)) + "," + STR$(d1) + ")  ="
  PRINT #1, s1$, a!(1, d1)
  PRINT #1, s2$, a!(2, d1)
NEXT
PRINT #1, "choppy!   ="; choppy!
PRINT #1, "delay!    ="; delay!
PRINT #1, "clr       ="; clr
PRINT #1, "fadr!     ="; fadr!
PRINT #1, "figures   ="; figures

CLOSE #1

PLAY "MBT255L16O4CDEGO6C"   '<- gaffled that from qblocks.bas (tetris),
                            '<cont> courtesy of microshaft..
EXIT SUB

eras:
  FOR d1 = 1 TO 4
    LOCATE d1, 1
    PRINT SPACE$(80)
  NEXT
  RETURN

END SUB
---- <eof>

Origin: Communication Breakdown * 314-225-4332