Dir$ and more GFX

[GordonSweet]

The gremlins seem to have crept in my previous post to produce a KALIEDSCOPE while playing MOD/MID files. This now works OK and proveds a list of Files to pick. Gordon

Code:

'Simple FMOD test for FB by Plasma  [11-16-2004]
screen 12
start:
cls: window

dim f$(200)
t$ = DIR$("*.mod")
C = 1 : T = 1
Do while t$ <> ""
      print tab(T);C;":";t$;
      f$(C)=t$
      C = C +1 : T= T +16
      if T > 60 then T =1 : Print
       t$ = DIR$("")
Loop

t$ = DIR$("*.mid")
Do while t$ <> ""
      print tab(T);C;":";t$;
      f$(C)=t$
      C = C +1 : T= T +16
      if T > 60 then T =1 : print
       t$ = DIR$("")
Loop
C = C -1 : print : print "     ";
input "Enter the number of the file to be played or 0 to abort ";F
File$ = f$(F)

DefSng A-Z
'$Include: 'fmod.bi'

Declare Sub ErrorQuit (Message$)

Const FALSE = 0
Const MusicFile = ""
    Dim Shared Handle As Long

    If FSOUND_GetVersion <= FMOD_VERSION Then
          ErrorQuit "FMOD version " + STR$(FMOD_VERSION) + " or greater required"
    End If

    If FSOUND_Init(44100, 32, 0) = FALSE Then
          ErrorQuit "Can't initialize FMOD"
    End If

    Handle = FMUSIC_LoadSong(File$)
    If Handle = FALSE Then
          ErrorQuit "Can't load music file " + CHR$(34) + MusicFile + CHR$(34)
    End if

    FMUSIC_PlaySong(Handle)

    Print "FMOD test for freeBASIC"
                  Print "Press any key to quit." : SLEEP 2000

REM KALIEDSCOPE originaly Written for the UK BBC Electron
    DIM X(3, 3), Y(3, 3), XC%(7), YC%(7)
    RANDOMIZE TIMER: RESTORE 500
    FOR I% = 1 TO 7
         READ XC%(I%), YC%(I%)
    NEXT
    SCALE1 = 250: SCALE2 = 400: WINDOW
    FIN = 0: C = 1: C% = 0
WHILE FIN =0
     S$ = "A"
     FOR P = 1 TO 2: CLS
      IF P = 2 THEN S$ = "B"
      C = C + 1: IF C = 4 THEN C = 1
      FOR L% = 1 TO 6
       GOSUB 300: REM CALCS
       PC% = INT(RND * 15) + 1: COLOR PC%
       IF S$ = "A" THEN K% = 1: GOTO 140
       FOR K% = 1 TO 7
140     WINDOW (0 - XC%(K%), 0 - YC%(K%))-(1279 - XC%(K%), 1023 - YC%(K%))
        GOSUB 410: REM TRIANGLES
        IF S$ = "A" THEN GOTO 180
       NEXT K%
180   NEXT L%
      REM Attempts to avoid full screen color flood
      ST = -600: EN = 600: IF S$ = "B" THEN ST = -50: EN = 1150
      CX% = 0: SX% = 0
      FOR TX% = ST TO EN STEP 20
       SX% = SX% + POINT(TX%, 0)
       CX% = CX% + 1
      NEXT TX%: TX% = TX% - 20
      IF SX% MOD CX% = 0 THEN GOTO 190
      SLEEP 2000
190  NEXT P
wend
    SLEEP
done:
    FMUSIC_FreeSong(Handle)
    FSOUND_Close
    if inkey$ <> "" then  goto start
    End

Sub ErrorQuit (Message$)

  print "ERROR: "; Message$
  FMUSIC_FreeSong(Handle)
  FSOUND_Close
  End 1

End Sub
    
300 REM CALCS
    IF INKEY$ <> "" THEN GOTO done
    IF S$ = "A" THEN SCALE = SCALE2 ELSE SCALE = SCALE1
    FOR J% = 1 TO 3
     R = SCALE * RND: TH = 1.047 * (RND + .5)
     X(1, J%) = R * COS(TH): Y(1, J%) = R * SIN(TH)
     XH = X(1, J%) / 2: XV = X(1, J%) * .866
     YH = Y(1, J%) * .866: YV = Y(1, J%) / 2
     X(2, J%) = YH + XH: Y(2, J%) = -YV + XV
     X(3, J%) = YH - XH: Y(3, J%) = -YV - XV
    NEXT J%: RETURN
410 REM TRIANGLES
    IF INKEY$<>"" THEN GOTO done    
    FOR I% = 1 TO 3
     PSET (X(I%, 1), Y(I%, 1))
     LINE -(X(I%, 2), Y(I%, 2))
     LINE -(X(I%, 3), Y(I%, 3)): LINE -(X(I%, 1), Y(I%, 1))
     PX% = (X(I%, 1) + X(I%, 2) + X(I%, 3)) / 3
     PY% = (Y(I%, 1) + Y(I%, 2) + Y(I%, 3)) / 3
     PAINT (PX%, PY%)
     PSET (-X(I%, 1), Y(I%, 1))
     LINE -(-X(I%, 2), Y(I%, 2))
     LINE -(-X(I%, 3), Y(I%, 3)): LINE -(-X(I%, 1), Y(I%, 1))
     PX = (-X(I%, 1) + -X(I%, 2) + -X(I%, 3)) / 3
     PY = (Y(I%, 1) + Y(I%, 2) + Y(I%, 3)) / 3: PAINT (PX, PY)
    NEXT I%: RETURN

500   DATA 640,514,370,994,910,994,1180,514,910,34,370,34,100,514