home *** CD-ROM | disk | FTP | other *** search
- '+==========================================================================+
- '| FUSION.BAS |
- '| Version 1.3 |
- '| Copyright (c) 1991, Lawrence Stone |
- '| All Rights Reserved |
- '| |
- '| THIS CODE IS FREE FOR USE AND MODIFICATION UNDER THESE STIPULATIONS: |
- '| |
- '| 1. You are not allowed to modify this and the following |
- '| text that explain the development of this program and |
- '| the names of people who freely supplied routines that |
- '| constitute this program. |
- '| |
- '| 2. You cannot charge any fee for this program or any program |
- '| that is principally comprised from this code, other than |
- '| a modest disk fee. |
- '| |
- '| 3. All contibuting authors involved with the development of |
- '| this program must be credited in the opening sceen of this |
- '| program or any program that is essentially composed of the |
- '| routines derived from this program (Since you didn't pay |
- '| for it, you might as well give credit where credit is due). |
- '| |
- '| 4. If you modify this routine, you must include a subsequent |
- '| block of text containing your name and your modifications, |
- '| and, you must include your name in the opening screen. |
- '| (Give yourself a pat on your back.) |
- '| |
- '+==========================================================================+
- '| |
- '| DESCRIPTION / HISTORY |
- '| |
- '| FUSION.BAS produces up to two kaleidoscopic designs per screen. Each |
- '| design is produced by a complex algorithm originally developed and |
- '| published by Charles Graham in his program, ENERGY12.BAS. |
- '| |
- '| I re-wrote Charles' routine to include random color, music played from |
- '| a background que, random arcs with random aspect ratios, and styled |
- '| lines using the style% variable with the LINE statement. I also have |
- '| included a routine that reads the ROM character table and positions |
- '| text characters at any pixel coordinates specified. This routine also |
- '| can create separate background colors for displayed character strings. |
- '| The algorithm for this routine was originally published in PC Magazine |
- '| and posted as a message on the Quik_BAS international echo by Richard |
- '| Randell. I have modified it as a subroutine called, "PrintROMtable" |
- '| and have expanded the algorithm to include shadows. |
- '| |
- '| The program has, essentially, four logical parts. At the top of the |
- '| code, the monitor is error trapped for EGA/VGA capabilities, then a |
- '| tiled background is drawn, orbs are drawn followed by the title (via a |
- '| call to "ShowTitle"), followed by credit displays (printed via the sub- |
- '| program, "PrintROMtable"), and finally, initiation of key trapping, |
- '| variable and background music. |
- '| |
- '| The second logical area is the main logic where weighted random numbers |
- '| determine how many elements each drawing will have, pixel locations for |
- '| each point of each drawing, color to use for each line or arc, whether |
- '| sound is on or off, and whether to display "energy" lines, "plasma" |
- '| lines, or, "muon" or "quark" trails. |
- '| |
- '| The third area contains subroutines which handle, color, music, screen |
- '| clearing, as well as, the number of pictures to display at once and |
- '| what palette to work with. |
- '| |
- '| The fourth area has the subprograms "PrintROMtable" and "ShowTitle". |
- '| ShowTitle simply restores the data beginning at the label, "ProgTitle" |
- '| then, reads the data, drawing one line at a time with a style% mask off |
- '| (&HFFFF) then redraws this same line with mask set. This produces an |
- '| interesting effect of a wood like grain to the display and, due to |
- '| the number of READs, the title seems to drip onto the screen. The |
- '| ShowTitle routine also shadows the title as it draws it. |
- '| |
- '| Another major addition to Charles' routine was the inclusion of true |
- '| background music while the extensive calculations are being performed |
- '| for the designs. The background music is the William Tell Overture, |
- '| who's author is unknown. Whoever took the time to put William Tell to |
- '| a series of PLAY command, the whole world owes you a hearty, "Thanks". |
- '| |
- '| The "+/-" and "Color" commands used in the original ENERGY program |
- '| (Charles' program) have been removed. These command keys were removed |
- '| because pitch command, "+/-", seemed unnecessary because FUSION includes|
- '| "The William Tell Overture", and color is now randomly produced. The |
- '| spacebar now is used to hold the screen image until the ESC key is |
- '| depressed. |
- '| |
- '| FUSION will cease playing The William Tell Overture while drawing |
- '| designs if, real-time, random ("spacenik") sounds, are "On". Spacenik |
- '| sounds (as coined by Charles Graham) can be toggled "Off" by pressing |
- '| the F2 key. It is your choice to listen to the sounds and music. You |
- '| can select one or the other or, both or, none by pressing F1 and F2. |
- '| |
- '| If "music" is "On" and "Spacenik Sound" is "Off" then the William Tell |
- '| Overture plays continuously - even while drawing a design! |
- '| |
- '| The bottom line of the screen is the prompt line. It tells you the |
- '| status of "Music" (On/Off) and "Spacenik sound" (On/Off). The prompt |
- '| also informs you to use F1, F2 to toggle music/sound, press spacebar to |
- '| hold a screen image, and press F10 to end the program. When the space- |
- '| bar is pressed, the prompt informs you to press "Esc" to compute and/or |
- '| display next drawing. |
- '| |
- '| The use of "real" music, "spacenik" sounds, "energy", "plasma", "muons" |
- '| and "quarks" result in a FUSION of the classical and contemporary that |
- '| will provide hours of enjoyment. In the words of Charles Graham, "Grab |
- '| a glass of wine, turn off the lights and ENJOY!" |
- '| |
- '| Requires an EGA or VGA monitor capable of a 640 x 350 or, 640 x 480 |
- '| color graphics resolution. |
- '| |
- '+==========================================================================+
- '| |
- '| TECHNICAL INFORMATION |
- '| |
- '| The algorithm developed by Charles Graham and used by FUSION to create |
- '| the "plasma" and "energy" designs is based upon the polar equation for |
- '| an ellipse where the pole is at the center, 'a' and 'b' are the semi- |
- '| axes, 'r' is the radius and theta is the angle in radians: |
- '| |
- '| 2 2 |
- '| 2 a b |
- '| r = ---------------------------------- |
- '| 2 2 2 2 |
- '| a SIN theta - b SIN theta |
- '| |
- '+==========================================================================+
- '| |
- '| CONTACTING THE AUTHORS |
- '| |
- '| Any donation to the authors as a way for you to say, "thank you", is |
- '| readily accepted. However, the authors will not accept a donation if |
- '| in excess of $10,000 <GRIN>. Seriously, questions and suggestions can |
- '| be addressed to: |
- '| |
- '| Larry Stone Author of FUSION. |
- '| P.O. Box 5715 |
- '| Charleston, OR 97420 |
- '| |
- '| Charles Graham Author of the algorithm to plot and |
- '| P.O. Box 58634 display the designs derived by the |
- '| St. Louis, MO 63158 polor equations for each ellipse |
- '| generated by weighted, random points. |
- '| |
- '| Anonymous The unknown hacker that actually took |
- '| Address Unknown the time to put the William Tell Over- |
- '| ture to code. This unknown tone master |
- '| mailed his work to Ethan Winer with a |
- '| set of instructions to share with the |
- '| world. Ethan did. Charles and I have. |
- '| Now, what about you? |
- '| |
- '+--------------------------------------------------------------------------+
-
- '+==========================================================================+
- '| QB Compile : bc fusion/E/X/V/W/O/T/C:512; |
- '| QB Link : link /EX fusion; |
- '| |
- '| PDS Compile: bc fusion/E/X/V/O/Ot/Lr/FPi/Es/T/C:512; |
- '| PDS Link : link /EX/NOE fusion+NOCGA+NOHERC+SMALLERR,,nul,BCL71ENR; |
- '+--------------------------------------------------------------------------+
-
- '+==========================================================================+
- '| Declarations |
- '+--------------------------------------------------------------------------+
-
- DECLARE SUB PrintROMtable (a$, x%, y%, StepX%, StepY%, CO%, BackGround%, Shadow%)
- DECLARE SUB ShowTitle (BeginLine%)
-
- CONST False = 0, True = NOT False
- OPTION BASE 1 'All arrays to start at 1 (not zero)
-
- '+==========================================================================+
- '| Initialization and Intro Screen |
- '+--------------------------------------------------------------------------+
-
- '---- Set VGA or EGA Graphic Screen.
- Mode% = 12
- ON ERROR GOTO BadMode
- SCREEN Mode%
- ON ERROR GOTO 0
-
- y% = 335
- IF Mode% = 12 THEN
- Vga% = 10
- y% = 460
- END IF
-
- VIEW SCREEN (0, 0)-(639, y%)
-
- DEFINT A-Z 'Default to integers for now
-
- '---- Draw a tiled window
- LINE (0, 0)-(639, y%), 15, B
- PAINT (300, 200), 3, 15
-
- IF Vga% THEN Vga% = 1
- x = 7: y = 33 + Vga%
-
- FOR V = 1 TO 10 + (Vga% * 3) 'Loop once for each verticle tile.
- FOR H = 1 TO 14 'Loop once for each horizontal tile.
- x1 = x: y1 = y
- x2 = x1 + 39: y2 = y1 - 29
- x3 = x1 + 40: y3 = y1 + 1 + Vga%
- x4 = x1 + 41: y4 = y1 - 28
- x5 = x + 1: y5 = y1 + 2 + Vga%
- LINE (x1, y1)-(x1, y2), 11 'Top of tile
- LINE -(x2, y2), 11 'Left side of tile
- LINE (x3, y2)-(x3, y3), 0 'Right side of tile
- LINE -(x1, y3), 0 'Bottom of tile
- LINE (x4, y4)-(x4, y5), 0 'Column #2 of right side (extra shade)
- LINE -(x5, y5), 0 'Row #2 of bottom side (extra shade)
- x = x + 45
- NEXT
- x = 7
- y = y + 33 + Vga% + Vga%
- NEXT
-
- IF Vga% THEN Vga% = 10
-
- '---- Draw the program title starting at pixel row 56
- ShowTitle 56
-
- '---- Force the compiler to put "fusion" in the token table so that the
- ' compiled program, when listed, clearly shows the name, followed by
- ' the version and the copyright notice.
- a$ = "FUSION"
-
- a$ = "VERSION 1.3"
- x% = 250: y% = 141 + Vga%: StepX% = 13: Klr% = 14: Shadow% = True
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, Shadow%
-
- a$ = "Copyright (C) 1991, Lawrence Stone. All Rights Reserved."
- x% = 119: y% = 155 + Vga%: StepX% = 7
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, Shadow%
-
- IF Vga% THEN Vga% = Vga% + 3
- a$ = "Based upon an orig"
- x% = 144: y% = 222 + Vga%: StepX% = 10: StepY% = True: Klr% = 15
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, Shadow%
-
- a$ = "inal algorithm by"
- x% = 325: y% = 206 + Vga%: StepY% = 1: Klr% = 15
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, Shadow%
-
- a$ = "Charles Graham"
- x% = 263: y% = 222 + Vga%: StepX% = 8: StepY% = False
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, Shadow%
-
- IF Vga% THEN Vga% = Vga% + 3
- a$ = "The William Tell Overture"
- x% = 143: y% = 269 + Vga%: StepX% = 7: StepY% = 1
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, Shadow%
-
- a$ = "translated for the PC by":
- x% = 324: y% = 293 + Vga%: StepX% = 7: StepY% = True
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, Shadow%
-
- a$ = "Anonymous"
- x% = 284: y% = 277 + Vga%: StepX% = 8: StepY% = False
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, Shadow%
-
- DEFSNG A-Z 'Default to single precision for now
-
- '---- Draw the fancy orbs for the intro screen.
- z = .1
- x = 12.1001
- Klr% = 3
- FOR z% = 1 TO 120
- CIRCLE (75, 90), 75, Klr%, , , z
- CIRCLE (563, 90), 75, Klr%, , , x
- Klr% = Klr% + 1
- IF Klr% > 15 THEN Klr% = 1
- z = z + .1
- x = x - .1
- NEXT
-
- '---- Establish some variables.
- On$ = "On "
- Off$ = "Off"
- F1$ = "F1: Music is "
- F2$ = " F2: Spacenik Sound is "
- mu% = True 'Music is on
- spacenik% = True 'spacenik noise is on
- colorWow% = 3 'Used to compute time of color change
- Pics2Display% = 1 'Number of pics to display at once -may become 2
- hold% = False 'Don't hold a screen image
-
- '---- Start the music playing in the background.
- playCount% = playCount% + 2
- READ m$ 'Read music initialization string
- PLAY ON 'Set QB's music handler on
- PLAY m$ 'Process the initiation string
- ON PLAY(3) GOSUB PlayMore 'Set music to trap when que has 3 characters
- READ m$ 'Read some music
- PLAY "MB X" + VARPTR$(m$) 'Play it from the background que.
-
- '---- Event trap for F1, F2, F10, and spacebar and escape keys.
- KEY 15, CHR$(0) + CHR$(57) 'Define Spacebar as key 15
- KEY 16, CHR$(0) + CHR$(1) 'Define Esc key as key 16
- KEY(1) ON 'F1
- KEY(2) ON 'F2
- KEY(10) ON 'F10
- KEY(15) ON
- KEY(16) ON
- ON KEY(1) GOSUB music
- ON KEY(2) GOSUB SpacenikNoise
- ON KEY(10) GOSUB ThatsAll
- ON KEY(15) GOSUB HoldImage
- ON KEY(16) GOSUB Esc
-
- GOSUB HoldImage 'Hold everything until the user hits "Esc"
-
- RANDOMIZE TIMER
- pi = 3.141593
- ymin = 640
- ymax = False
-
- a$ = " Computing... "
- x% = 238: y% = 247 + Vga%: StepX% = 12: Klr% = 14: BG% = 4
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, True
- a$ = ""
-
- '---- UnREM the next two lines if using PDS 7.1 (QB 4.0b can't handle it)
- 'DEFINT F-G, L-N, Y-Z 'Make these integers for extra speed
- 'DEFLNG A-B, X 'Make these long integers for speed
-
- '+==========================================================================+
- '| Main Logic |
- '+--------------------------------------------------------------------------+
-
- DO
- '---- Is sound on or off?
- IF mu% = True THEN PLAY ON
-
- displayCount% = displayCount% + 1 'Number of pictures displayed
- g = INT(RND * 590) + 50 '50 - 640 possible points to each drawing
- w = INT(RND * 1.9) + .1 'weighted factor used for yavg, etc.
- f = INT(RND * 96) + 5 'weighted factor used for m and u below
-
- m = 4 * f 'The number elements in dimension #1
-
- '---- t() is a "theta" factor used in calculating locations, x(), and
- ' y(), as well as, used to compute the radius, r() of the equation.
-
- REDIM t(m)
-
- u = pi / 2 / f
- FOR z = 1 TO m
- t(z) = u * (z - 1)
- NEXT
-
- '---- The number of 'loci'
- n = INT(RND * 9) + 2 'The number elements in dimension #2
-
- '---- x() & y() are graphic drawing points...
- ' a() & b() are semi-axis and c() is the product of a() & b()
- REDIM x(m, n), y(m, n), a(n), b(n), c(n)
-
- '---- Initialize coordinates x() and y(); semi-axis a() and b(), their
- ' product c(); and, compute ymin and ymax
- FOR z = 1 TO n
- x(1, z) = INT(RND * 640)
- a(z) = (x(1, z) - g) * (x(1, z) - g)
- b(z) = ((x(1, z) - g) * (1 - w)) * ((x(1, z) - g) * (1 - w))
- c(z) = a(z) * (b(z) * 1!) '--- b()* 1! forces SINGLE to handle big num
- y(1, z) = INT(RND * 350)
-
- IF y(1, z) < ymin THEN
- ymin = y(1, z)
- END IF
-
- IF y(1, z) > ymax THEN
- ymax = y(1, z)
- END IF
- NEXT
-
- '---- Calculate yavg
- yavg = CINT(((ymax - ymin) / 2) + ymin)
-
- '---- Scale the graphic coordinate y(1, z) to yavg
- FOR z = 1 TO n
- IF y(1, z) > yavg THEN
- y(1, z) = CINT(yavg + (ABS(y(1, z) - yavg) * w))
- ELSEIF y(1, z) < yavg THEN
- y(1, z) = CINT(yavg - (ABS(y(1, z) - yavg) * w))
- END IF
- NEXT
-
- '---- Calculate the design
- FOR z = 2 TO m
- FOR l = 1 TO n
-
- '---- Set a new palette.
- GOSUB NewPalette
-
- '---- Compute the radius of the ellipse and scale the graphic
- ' coordinates y(2+, l) to this radius. The coordinate x(2+,l)
- ' is either assigned to the point or is computed using the
- ' values of the radius, r, divided by the arc-cosine theta
- ' subtracted from the value of the point.
-
- IF (x(1, l) < g) THEN
- r = SQR(c(l) / (a(l) * (SIN(t(z)) * SIN(t(z))) + (b(l) * (COS(t(z)) * COS(t(z))))))
-
- IF ((ABS(COS(t(z)))) < .000001) THEN
- x(z, l) = g
- ELSE
- x(z, l) = g - CINT(r / (1 / COS(t(z))))
- END IF
-
- y(z, l) = y(1, l) + CINT(r * (SIN(t(z))))
-
- ELSEIF (x(1, l) > g) THEN
- r = SQR(c(l) / (a(l) * (SIN(t(z)) * SIN(t(z))) + (b(l) * (COS(t(z)) * COS(t(z))))))
-
- IF ((ABS(COS(t(z)))) < .000001) THEN
- x(z, l) = g
- ELSE
- x(z, l) = g + CINT(r / (1 / COS(t(z))))
- END IF
-
- y(z, l) = y(1, l) - CINT(r * (SIN(t(z))))
-
- ELSE
- x(z, l) = g
- y(z, l) = y(1, l)
- END IF
- NEXT
- NEXT
-
- '---- Calculate a new color to use.
- last% = Klr%
- WHILE last% = Klr%
- Klr% = INT(RND * 16)
- WEND
-
- '---- Do we need to clear the screen?
- IF displayCount% MOD Pics2Display% = False THEN
- GOSUB Klear
- displayCount% = False
- END IF
-
- '---- Stop playing and allow spacenik noise.
- IF spacenik% OR NOT mu% THEN
- PLAY STOP
- GOSUB CountDown
- END IF
-
- FOR z = 1 TO m
-
- '---- Are sounds on or off?
- IF spacenik% THEN
- SOUND INT(200 * RND + 40 + r + 20), 1
- ELSEIF mu% AND NOT spacenik% THEN
- PLAY ON
- END IF
-
- '---- Display the design.
- FOR l = 1 TO n
-
- '---- Circle calculations are performed at element #1 and at the
- ' halfway element of dimension #2.
- IF (l = 1) OR (l = n \ 2) THEN
-
- '---- Calculate a divisor
- divisor = x(z, l) * RND
- IF divisor = False THEN divisor = .0001
-
- '---- Calculate an aspect ratio
- aspect! = RND * ((y(z, l) * RND) / divisor)
-
- '---- Calculate the end of the arc
- endArc = ABS(aspect! * RND)
- CalcEndArc:
- IF endArc > 6.28 THEN endArc = endArc / 10: GOTO CalcEndArc
-
- '---- Calculate the start of the arc
- startArc = ABS(RND * aspect!)
- IF startArc > 6.28 THEN startArc = .0001
- IF RND * 5 > 2.5 THEN SWAP startArc, endArc
-
- mCheck% = INT(RND * m) + 1
-
- IF z MOD mCheck% = False THEN
- '---- Draw a "muon" trail if z MOD random number = False
- ' Note the "muon" trail is an arc with its own ellipse
-
- radius% = ABS(y(z, l) * RND)
- CIRCLE (x(z, l), y(z, l)), radius%, Klr%, startArc, endArc, aspect!
- ELSE
- IF radius% THEN
- '---- Draw a "quark" trail if radius% is not zero.
- ' The "quark" trail has no aspect!
-
- CIRCLE (x(z, l), y(z, l)), radius%, Klr%, startArc, endArc
- ELSE
- '---- Set a point if radius is zero.
-
- CIRCLE (x(z, l), y(z, l)), radius%, Klr%
- END IF
- END IF
-
- '---- Clear the radius on a weighted, random basis.
- IF RND > .85 THEN radius% = False
-
- '---- If not at element #1 or the halfway element of dimension #2
- ' then draw one of the line types.
- ELSEIF plasma% AND displayCount% MOD 2 = False THEN
- '---- Draw an "energy" line if display count is 2
- ' and "plasma%" is not zero.
-
- LINE -(x(z, l), y(z, l)), Klr%
- ELSEIF displayCount% MOD 2 <> False AND NOT plasma% THEN
- '---- Draw an "energy" line if display count is 1 and
- ' "plasma" is zero.
-
- LINE -(x(z, l), y(z, l)), Klr%
- ELSE
- '---- Otherwise, draw an "plasma" line.
-
- LINE -(x(z, l), y(z, l)), Klr%, , INT(RND * 4096)
- END IF
- NEXT
-
- '---- Calculate a new color to use within the design.
- IF z MOD colorWow% = False THEN GOSUB ChngKlr
- NEXT
- '---- Clear the arrays and reset radius% to zero
- ERASE t, x, y, a, b, c
- radius% = False
- LOOP
-
- '+==========================================================================+
- '| Subroutines |
- '+--------------------------------------------------------------------------+
-
- music:
- mu% = mu% XOR True 'Toggle Music
- IF NOT mu% THEN
- PLAY STOP
- GOSUB CountDown
- ELSE
- PLAY ON
- IF NOT spacenik% THEN spacenik% = True 'If music then also spacenik
- END IF 'noises will be on.
- GOSUB DisplayPrompt
- RETURN
-
- SpacenikNoise:
- spacenik% = spacenik% XOR True 'Toggle spacenik noises
- GOSUB DisplayPrompt
- RETURN
-
- Klear: 'Clear the screen
- COLOR 0
- CLS
- GOSUB DisplayPrompt
- GOSUB ChngKlr
-
- SetPictureRate:
- Pics2Display% = INT(RND * 3) 'Max Pics2Display% is 2
- IF Pics2Display% = False GOTO SetPictureRate
-
- '---- Togle plasma lines
- plasma% = plasma% XOR True
- RETURN
-
- ChngKlr:
- Klr% = INT(RND * 16)
-
- NewColorWow:
- colorWow% = INT(RND * 16)
- IF colorWow% = False GOTO NewColorWow
- RETURN
-
- NewPalette:
- clr% = CINT(RND * 14) + 1
- IF Vga% THEN
- pal& = 65536 * (INT(RND * 63) + 1) + 256& * (INT(RND * 63) + 1) + (INT(RND * 63) + 1)
- ELSE
- pal& = INT(RND * 63) + 1
- END IF
- PALETTE clr%, pal&
- RETURN
-
- HoldImage:
- hold% = True: Cleared% = False
- GOSUB DisplayPrompt
- DO: LOOP UNTIL Cleared% 'Hold image until Esc pressed
- hold% = False
- GOSUB DisplayPrompt
- RETURN
-
- Esc:
- Cleared% = True 'Break out of HoldImage routine
- RETURN
-
- DisplayPrompt:
- IF Vga% THEN LOCATE 30, 1 ELSE LOCATE 25, 1
- COLOR 3
- IF hold% THEN PRINT " ";
- PRINT F1$;
- COLOR 14
- IF mu% THEN PRINT On$; ELSE PRINT Off$;
- COLOR 3: PRINT F2$;
- COLOR 14
- IF spacenik% THEN PRINT On$; ELSE PRINT Off$;
- COLOR 3
- IF hold% = False THEN 'If holding the image then...
- PRINT " SPACEBAR to ";
- COLOR 14: PRINT "Hold Image ";
- ELSE 'Otherwise...
- COLOR 11: PRINT " ESC to ";
- COLOR 14: PRINT "Design/Draw ";
- END IF
- COLOR 3: PRINT "F10 to ";
- COLOR 14: PRINT "END";
- IF hold% THEN PRINT " "; 'If holding the image buffer line
- RETURN
-
- PlayMore:
- playCount% = playCount% + 1 'INC number of READs by 1
- IF playCount% > 100 THEN 'Only 100 lines to read!
- PLAY STOP 'Stop the music
- RESTORE MusicData 'Restore the music data
- playCount% = 2 'We'll be reading 2 lines
- READ m$ 'Read initiation string
- PLAY ON 'Turn on PLAY
- PLAY m$ 'Process initiation code
- END IF
- READ m$ 'Read some music
- PLAY "MB X" + VARPTR$(m$) 'Set music to trap when que has 3 characters
- RETURN
-
- CountDown:
- DO
- NoteCount% = PLAY(0)
- DO 'Check each DEC from que.
- LOOP UNTIL NoteCount% <> PLAY(0) OR NoteCount% = False
- LOOP UNTIL NoteCount% = False 'If que empty then exit loop
- RETURN
-
- ThatsAll:
- PLAY OFF 'Turn of music
- GOSUB CountDown 'Clear the music Que
- IF Vga% THEN y% = 479 ELSE y% = 349
- VIEW SCREEN (0, 0)-(639, y%) 'View the entire screen
- PALETTE 'Restore palette
- CLS
-
- a$ = "Thank you for using..."
- x% = 169: y% = 115: StepX% = 14: Klr% = 11: BG% = False
- PrintROMtable a$, x%, y%, StepX%, StepY%, Klr%, BG%, False
-
- '---- Draw the program title
- ShowTitle 156
-
- FOR rest = 1 TO 10000: NEXT 'Hold the message for awhile
-
- VIEW PRINT 1 TO 25
- SCREEN 0
- COLOR 7, 0
- CLS
- END
-
- BadMode:
- z% = ERR
- IF Mode% = 12 THEN 'If VGA produced error try EGA
- Mode% = 9
- RESUME
- END IF
- SCREEN 0 'If EGA produced error then END
- CLS
- PRINT "EGA or VGA Color Monitor Required to Run FUSION"
- PRINT "Program Aborted"
- END
-
- '+==========================================================================+
- '| Data |
- '+--------------------------------------------------------------------------+
-
- MusicData:
- DATA "mfl16t155"
- DATA "o2mnb4p8msbbmnb4p8msbbb8g#8"
- DATA "e8g#8b8g#8b8o3e8o2b8g#8e8g#8"
- DATA "b8g#8b8o3e8o2mnb4p8msbbmnb4"
- DATA "p8msbbmnb4p8msbbmnb4p8msbb"
- DATA "b8bbb8b8b8bbb8b8b8bb"
- DATA "b8b8b8bbb8b8mlb2b2b8p8p4p4"
- DATA "p8mso1bbb8bbb8bbo2e8f#8g#8o1bb"
- DATA "b8bbo2e8g#g#f#8d#8o1b8bbb8bb"
- DATA "b8bbo2e8f#8g#8eg#mlb4bmsag#f#"
- DATA "e8g#8e8o3bbb8bbb8bbo4e8f#8"
- DATA "g#8o3bbb8bbo4e8g#g#f#8d#8o3b8bb"
- DATA "b8bbb8bbo4e8f#8g#8mleg#b4"
- DATA "bag#f#mse8g#8e8o3g#g#g#8g#g#g#8g#g#"
- DATA "g#8o4c#8o3g#8o4c#8o3g#8o4c#8o3g#8f#8e8d#8"
- DATA "c#8g#g#g#8g#g#g#8g#g#g#8o4c#8o3g#8o4c#8"
- DATA "o3g#8o4c#8o3b8a#8b8a#8b8g#g#g#8g#g#"
- DATA "g#8g#g#g#8o4c#8o3g#8o4c#8o3g#8o4c#8o3g#8f#8"
- DATA "e8d#8c#8g#g#g#8g#g#g#8g#g#g#8o4c#8"
- DATA "o3g#8o4c#8o3g#8o4c#8o3b8a#8b8o2bbb8f#f#"
- DATA "f#8f#f#f#8g#8a8f#4mna8msg#8mne4"
- DATA "msg#8f#8f#8f#8o3f#f#f#8f#f#f#8g#8"
- DATA "a8mnf#4msa8g#8mne4msg#8f#8o2bb"
- DATA "b8o1bbb8bbb8bbo2mne8f#8g#8o1bb"
- DATA "b8bbo2e8g#g#f#8d#8o1b8bbb8bb"
- DATA "b8bbo2e8f#8g#8eg#mlb4mnbag#f#"
- DATA "e8g#8e8o3bbb8bbb8bbo4e8f#8"
- DATA "g#8o3bbb8bbo4e8g#g#f#8d#8o3b8bb"
- DATA "b8bbb8bbo4e8f#8g#8mleg#mlb4"
- DATA "mnbag#f#mne8g#8e8o3mle56f56g56a56b56o4c56d56mne8eee8e8mlg#4g#8"
- DATA "mnf#8e8d#8e8c#8mso3bo4c#o3bo4c#o3b"
- DATA "o4c#d#eo3abababo4c#d#o3g#ag#ag#abo4c#o3f#"
- DATA "g#f#g#f#g#f#g#f#g#f#d#o2bo3mlbo4c#d#e8d#8e8"
- DATA "c#8o3msbo4c#o3bo4c#o3bo4c#d#eo3abababo4c#d#o3g#"
- DATA "ag#ag#abo4c#o3f#g#f#g#f#af#emne8p8mlc#4"
- DATA "mnc#o2cmso3c#o2co3d#c#o2baag#ec#c#c#c#c#e"
- DATA "d#o1cg#g#g#g#g#g#o2c#eg#o3c#c#c#c#c#o2co3c#o2co3d#"
- DATA "c#o2baag#ec#c#c#c#c#ed#o1cg#g#g#g#g#mng#"
- DATA "o2c#eg#o3msc#ed#c#d#o2cg#g#g#o3g#ec#d#o2cg#g#g#"
- DATA "o3g#ec#d#o2bg#g#a#gd#d#g#gg#gg#ag#f#e"
- DATA "o1ba#bo2eo1bo2f#o1bo2g#ed#eg#eaf#bo3g#f#ed#"
- DATA "f#ec#o2bo3c#o2bo3c#d#ef#g#o2ababo3c#d#ef#o2g#"
- DATA "ag#aco3c#d#eo2f#g#f#g#f#g#f#g#f#g#f#d#o1b"
- DATA "co2c#d#eo1ba#bo2eo1bo2f#o1bo2g#ed#eg#eaf#b"
- DATA "o3g#f#ed#f#ec#o2bo3c#o2bo3c#d#ef#g#o2ababo3c#"
- DATA "d#ef#o2g#ag#abo3c#d#eo2f#o3c#o2co3c#d#c#o2af#mne"
- DATA "o3mlef#g#abo4c#d#mne8mseee8e8mlg#4g#8"
- DATA "msf#8mse8d#8e8c#8o3bo4c#o3bo4c#o3bo4c#d#eo3a"
- DATA "bababo4c#d#o3g#ag#ag#abo4c#o3f#g#f#g#f#"
- DATA "g#f#g#f#g#f#d#o2bo3mlbo4c#d#mne8eee8e8mlg#4g#8"
- DATA "msf#8e8d#8e8c#8o3bo4c#o3bo4c#o3b"
- DATA "o4c#d#eo3abababo4c#d#o3g#ag#ag#abo4c#o3f#"
- DATA "g#f#g#f#ag#f#e8o2b8o3e8g#g#g#8mng#g#g#8"
- DATA "g#g#g#8o4c#8o3g#8o4c#8o3g#8o4c#8o3g#8f#8e8"
- DATA "d#8c#8g#g#g#8g#g#g#8g#g#g#8o4c#8o3g#8"
- DATA "o4c#8o3g#8o4c#8o3b8a#8b8a#8b8g#g#g#8"
- DATA "g#g#g#8g#g#g#8o4c#8o3g#8o4c#8o3g#8o4c#8o3g#8"
- DATA "f#8e8d#8c#8g#g#g#8g#g#g#8g#g#g#8"
- DATA "o4c#8o3g#8o4c#8o3g#8o4c#8o3b8a#8b8a#8b8"
- DATA "o2f#f#f#8f#f#f#8g#8a8f#4a8g#8"
- DATA "e4g#8f#8o0b8o1b8o2f#f#f#8f#f#f#8"
- DATA "g#8a8f#4a8g#8e4g#8f#8"
- DATA "bbb8o1bbb8bbb8bbo2e8f#8g#8"
- DATA "o1bbb8bbo2e8g#g#f#8d#8o1b8bbb8"
- DATA "bbb8bbo2e8f#8g#8eg#mlb4mnb"
- DATA "ag#f#e8o1b8o2e8o3bbb8bbb8bbo4e8"
- DATA "f#8g#8o3bbb8bbo4e8g#g#f#8d#8o3b8"
- DATA "bbb8bbb8bbo4e8f#8g#8o3eg#mlb4"
- DATA "mnbag#f#mlef#g#mnamlg#abo4mnc#mlo3bo4c#d#mnemld#"
- DATA "ef#mng#ao3bo4ao3bo4ao3bo4ao3bo4ao3bo4ao3bo4ao3bo4ao3bmle"
- DATA "f#g#mnamlg#abmno4c#mlo3bo4c#d#mnemld#ef#mng#ao3bo4ao3bo4a"
- DATA "o3bo4ao3bo4ao3bo4ao3bo4ao3bo4ao3bp16mlg#o4g#o3mng#p16mld#o4d#o3mnd#p16"
- DATA "mleo4eo3mnep16mlao4ao3mnap16mlg#o4g#o3mng#p16mld#o4d#o3mnd#p16mleo4eo3mnep16"
- DATA "mlao4ao3mnao4go3go4go3go4go3go4go3go4msg8e8c8e8o4mng#"
- DATA "o3g#o4g#o3g#o4g#o3g#o4g#o3g#o4msg#8e8o3b8o4e8mng#o3g#o4g#o3g#o4g#"
- DATA "o3g#o4g#o3g#o4msg#8f8c#8f8mna#o3a#o4a#o3a#o4a#o3a#o4a#o3a#o4msa#8"
- DATA "g8e8g8b8p16mna#p16ap16g#p16f#p16ep16"
- DATA "d#p16c#p16o3bp16a#p16ap16g#p16f#p16ep16d#p16f#mle"
- DATA "f#g#mnamlg#abmno4c#o3mlbo4c#d#mnemld#ef#mng#ao3bo4ao3bo4a"
- DATA "o3bo4ao3bo4ao3bo4ao3bo4ao3bo4ao3bmlef#g#mnamlg#abmno4c#o3mlb"
- DATA "o4c#d#mnemld#ef#mng#ao3bo4ao3bo4ao3bo4ao3bo4ao3bo4ao3bo4a"
- DATA "o3bo4ao3bp16mlg#o4g#o3mng#p16mld#o4d#o3mnd#p16mleo4eo3mnep16mlao4ao3mnap16"
- DATA "mlg#o4g#o3mng#p16mld#o4d#o3mnd#p16mleo4eo3mnep16mlao4ao3mnao4go3go4go3go4g"
- DATA "o3go4go3go4g8e8c8e8g#o3g#o4g#o3g#o4g#o3g#o4g#o3g#o4g#8"
- DATA "e8o3b8o4e8g#o3g#o4g#o3g#o4g#o3g#o4g#o3g#o4msg#8mnf8c#8"
- DATA "f8a#o3a#o4a#o3a#o4a#o3a#o4a#o3a#o4a#8g8e8g8b8"
- DATA "p16a#p16ap16g#p16f#p16ep16d#p16c#p16o3bp16a#p16"
- DATA "ap16g#p16f#p16ep16d#p16fmled#ed#mne8bbb8"
- DATA "bbb8bbo4e8f#8g#8o3bbb8bbb8"
- DATA "bbo4g#8a8b8p8e8f#8g#8p8o3g#8"
- DATA "a8b8p8p2o2bco3c#dd#"
- DATA "eff#gg#aa#bco4c#d#ed#f#d#ed#f#d#e"
- DATA "d#f#d#ed#f#d#ed#f#d#ed#f#d#ed#f#d#e"
- DATA "d#f#d#e8eo3eo4eo3eo4eo3eo4e8o3bo2bo3bo2bo3bo2bo3b8"
- DATA "g#o2g#o3g#o2g#o3g#o2g#o3g8eo2eo3eo2eo3eo2eo3e8eee8"
- DATA "e8e8o2bbb8b8b8g#g#g#8g#8g#8"
- DATA "eee8e8e8o1b8o2e8o1b8o2g#8e8b8"
- DATA "g#8o3e8o2b8o3e8o2b8o3g#8e8b8g#8o4e4"
- DATA "p8eee8e8e8e8e4p8p16"
- DATA "ee4p8p16o2ee2"
-
- ProgTitle:
- DATA 8, 163, 196, 208, 208, 255, 255, 283, 316, 343, 343, 369, 398, 424, 438, 487, 487
- DATA 8, 159, 198, 208, 208, 255, 255, 279, 318, 343, 343, 367, 400, 424, 439, 487, 487
- DATA 8, 156, 198, 208, 209, 254, 255, 276, 318, 342, 343, 365, 402, 424, 440, 486, 487
- DATA 8, 155, 199, 208, 210, 253, 255, 275, 319, 341, 343, 364, 403, 424, 440, 485, 487
- DATA 8, 154, 198, 208, 212, 252, 255, 274, 318, 340, 343, 363, 404, 424, 441, 484, 487
- DATA 8, 153, 198, 208, 214, 250, 255, 273, 318, 338, 343, 362, 405, 424, 442, 482, 487
- DATA 8, 153, 196, 208, 215, 249, 255, 273, 316, 337, 343, 361, 406, 424, 442, 481, 487
- DATA 9, 152, 167, 208, 215, 248, 255, 272, 287, 336, 343, 360, 375, 391, 407, 424, 443, 480, 487
- DATA 9, 152, 164, 208, 215, 248, 255, 272, 284, 336, 343, 360, 373, 393, 407, 424, 443, 480, 487
- DATA 9, 152, 162, 208, 215, 248, 255, 272, 282, 336, 343, 360, 372, 394, 407, 424, 444, 480, 487
- DATA 9, 152, 161, 208, 215, 248, 255, 272, 281, 336, 343, 360, 371, 396, 407, 424, 444, 480, 487
- DATA 9, 152, 161, 208, 215, 248, 255, 272, 281, 336, 343, 360, 370, 398, 407, 424, 445, 480, 487
- DATA 10, 152, 160, 208, 215, 248, 255, 272, 280, 336, 343, 360, 369, 398, 407, 424, 431, 433, 446, 480, 487
- DATA 10, 152, 160, 208, 215, 248, 255, 272, 280, 336, 343, 360, 368, 399, 407, 424, 431, 433, 446, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 368, 399, 407, 424, 431, 434, 447, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 367, 400, 407, 424, 431, 434, 448, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 367, 400, 407, 424, 431, 435, 448, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 367, 400, 407, 424, 431, 435, 449, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 367, 400, 407, 424, 431, 436, 450, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 367, 400, 407, 424, 431, 437, 451, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 367, 400, 407, 424, 431, 437, 451, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 367, 400, 407, 424, 431, 438, 452, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 279, 336, 343, 360, 367, 400, 407, 424, 431, 439, 453, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 272, 280, 336, 343, 360, 367, 400, 407, 424, 431, 439, 453, 480, 487
- DATA 10, 152, 160, 208, 215, 248, 255, 272, 281, 336, 343, 360, 367, 400, 407, 424, 431, 440, 454, 480, 487
- DATA 10, 152, 160, 208, 215, 248, 255, 272, 281, 336, 343, 360, 367, 400, 407, 424, 431, 441, 455, 480, 487
- DATA 10, 152, 162, 208, 215, 248, 255, 272, 283, 336, 343, 360, 367, 400, 407, 424, 431, 441, 455, 480, 487
- DATA 10, 152, 165, 208, 215, 248, 255, 272, 285, 336, 343, 360, 367, 400, 407, 424, 431, 442, 456, 480, 487
- DATA 10, 152, 180, 208, 215, 248, 255, 272, 309, 336, 343, 360, 367, 400, 407, 424, 431, 442, 457, 480, 487
- DATA 10, 152, 182, 208, 215, 248, 255, 273, 312, 336, 343, 360, 367, 400, 407, 424, 431, 443, 458, 480, 487
- DATA 10, 152, 182, 208, 215, 248, 255, 274, 313, 336, 343, 360, 367, 400, 407, 424, 431, 444, 459, 480, 487
- DATA 10, 152, 183, 208, 215, 248, 255, 275, 315, 336, 343, 360, 367, 400, 407, 424, 431, 445, 460, 480, 487
- DATA 10, 152, 182, 208, 215, 248, 255, 276, 316, 336, 343, 360, 367, 400, 407, 424, 431, 446, 461, 480, 487
- DATA 10, 152, 182, 208, 215, 248, 255, 279, 317, 336, 343, 360, 367, 400, 407, 424, 431, 446, 461, 480, 487
- DATA 10, 152, 180, 208, 215, 248, 255, 281, 317, 336, 343, 360, 367, 400, 407, 424, 431, 447, 462, 480, 487
- DATA 10, 152, 165, 208, 215, 248, 255, 302, 318, 336, 343, 360, 367, 400, 407, 424, 431, 448, 463, 480, 487
- DATA 10, 152, 162, 208, 215, 248, 255, 305, 318, 336, 343, 360, 367, 400, 407, 424, 431, 448, 463, 480, 487
- DATA 10, 152, 160, 208, 215, 248, 255, 307, 319, 336, 343, 360, 367, 400, 407, 424, 431, 449, 464, 480, 487
- DATA 10, 152, 160, 208, 215, 248, 255, 309, 319, 336, 343, 360, 367, 400, 407, 424, 431, 450, 465, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 310, 319, 336, 343, 360, 367, 400, 407, 424, 431, 451, 466, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 311, 319, 336, 343, 360, 367, 400, 407, 424, 431, 451, 466, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 311, 319, 336, 343, 360, 367, 400, 407, 424, 431, 452, 467, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 453, 468, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 454, 469, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 454, 469, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 455, 470, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 455, 470, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 456, 471, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 457, 472, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 458, 473, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 458, 473, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 459, 474, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 460, 475, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 461, 476, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 367, 400, 407, 424, 431, 461, 476, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 368, 399, 407, 424, 431, 462, 477, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 368, 399, 407, 424, 431, 462, 477, 480, 487
- DATA 10, 152, 159, 208, 215, 248, 255, 312, 319, 336, 343, 360, 368, 399, 407, 424, 431, 463, 477, 480, 487
- DATA 10, 152, 159, 208, 216, 247, 255, 275, 280, 311, 319, 336, 343, 360, 369, 398, 407, 424, 431, 463, 487
- DATA 10, 152, 159, 208, 216, 247, 255, 274, 281, 311, 319, 336, 343, 360, 370, 398, 407, 424, 431, 464, 487
- DATA 10, 152, 159, 208, 218, 245, 255, 273, 282, 309, 319, 336, 343, 360, 371, 396, 407, 424, 431, 465, 487
- DATA 10, 152, 159, 208, 220, 243, 255, 273, 284, 307, 319, 336, 343, 360, 372, 394, 407, 424, 431, 466, 487
- DATA 10, 152, 159, 208, 221, 242, 255, 273, 285, 306, 319, 336, 343, 360, 373, 393, 407, 424, 431, 466, 487
- DATA 10, 152, 159, 209, 223, 240, 254, 273, 287, 304, 319, 336, 343, 360, 375, 391, 407, 424, 431, 467, 487
- DATA 7, 152, 159, 209, 254, 273, 319, 336, 343, 361, 406, 424, 431, 468, 487
- DATA 7, 152, 159, 211, 252, 274, 319, 336, 342, 362, 405, 424, 431, 469, 487
- DATA 7, 152, 158, 212, 251, 275, 318, 336, 340, 363, 404, 424, 430, 469, 487
- DATA 7, 152, 156, 213, 250, 276, 317, 336, 338, 364, 403, 424, 428, 470, 487
- DATA 7, 152, 154, 214, 249, 277, 316, 336, 338, 365, 402, 424, 426, 470, 487
- DATA 7, 152, 153, 216, 247, 279, 314, 336, 337, 367, 400, 424, 425, 471, 487
- DATA 7, 152, 152, 218, 245, 281, 312, 336, 336, 369, 398, 424, 424, 472, 487
-
- '+==========================================================================+
- '| Subprograms and Functions |
- '+--------------------------------------------------------------------------+
-
- SUB PrintROMtable (a$, x%, y%, StepX%, StepY%, CO%, BackGround%, Shadow%)
-
- '+======================================================================+
- '| PrintROMtable Subroutine |
- '| |
- '| INP: a$ String of characters to print. |
- '| x% Starting column, in pixel points. |
- '| y% Starting row in pixel points. |
- '| StepX% Count from 1st dot of character, right/left # pixels. |
- '| Example: 8 = 8 right; -8 = 8 left (prints reverse). |
- '| StepY% Count from 1st dot of character, down/up # pixels. |
- '| Example: 1 = 1 down; -8 = 8 up (prints bottom - up). |
- '| CO% The color to make each character. |
- '| BackGround% Non-zero values determine the background color |
- '| for the string. Background is unchanged with "0". |
- '| (Refer to "Note".) |
- '| Shadow% True or false Boolian variable. |
- '| |
- '| OUT: 1) String of characters printed to the graphics screen. |
- '| 2) Location and slant of displayed string are pixel based. |
- '| 3) Characters can have both foreground and background colors. |
- '| 4) Characters can optionally be printed with a shadow. |
- '| |
- '| Note: Background% = 256 for color zero; 0 for no background change. |
- '+----------------------------------------------------------------------+
-
- '---- Don't destroy StepX and StepY.
- extX% = StepX%: extY% = StepY%
-
- DEF SEG = &HFFA6 'ROM segment for character shape tables
- FOR i% = 1 TO LEN(a$)
- addr% = 8 * ASC(MID$(a$, i%)) + 14 'Address character shape table
-
- IF BackGround% THEN 'Color background
- '---- Backgrounds equal to 256 are really color zero.
- IF BackGround% = 256 THEN BG% = False ELSE BG% = BackGround%
-
- '---- Prevent coloring background beyond range of string.
- IF i% = LEN(a$) THEN extX% = False: extY% = False
-
- '---- Box and paint a background for the character.
- LINE (x%, y%)-(x% + 7 + extX%, y% + 7 + extY%), BG%, BF
- END IF
-
- FOR j% = 0 TO 7
- '---- Peek 1 scan line from the table at a time, then shift bits
- ' left 8 places
- mask% = PEEK(addr% + j%) * 128
-
- '---- If shadow then displace line by 2 pixels and draw with
- ' black style mask
- IF Shadow% THEN
- LINE (x% + 9, y% + j% + 2)-(x% + 2, y% + j% + 2), 0, , mask%
- END IF
-
- '---- Draw the masked line with the assigned color attribute
- LINE (x% + 7, y% + j%)-(x%, y% + j%), CO%, , mask%
- NEXT
-
- '---- INC x% and y% by values extX% and extY%
- x% = x% + extX%
- y% = y% + extY%
- NEXT
- DEF SEG 'Return to BASIC DGROUP
-
- END SUB
-
- SUB ShowTitle (BeginLine%)
-
- RESTORE ProgTitle 'Restore the music data
- FOR y% = BeginLine% TO BeginLine% + 69 'Loop 70 times
- READ z% 'How many line to draw
- FOR b% = 1 TO z% 'Loop that many times
- READ x%, x1% 'Read start & end coordinates
- FOR c% = 1 TO 2 'Loop and draw each line twice
- IF c% = 1 THEN 'Loop #1 draws a solid line
- mask% = &HFFFF 'Turns mask% off
- Klr% = 14
- ELSE
- '---- Stripe it by redrawing with style mask
- mask% = 521
- Klr% = 9
- END IF
- LINE (x%, y%)-(x1%, y%), Klr%, , mask%
- NEXT
- '---- Shadow the lines.
- LINE (x% + 3, y% + 3)-(x1% + 3, y% + 3), 0
- NEXT
- NEXT
- RESTORE MusicData 'Restore ALL data
-
- END SUB
-
-